You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

4964 lines
240 KiB

( disk B, side 0)
( REGULAR FONT )
code romanfont nx ) jsr, ;c ( define font table )
here maxi to
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 00 00 chr ( )
00 00 00 00 00 7e 7e 00 00 00 00 00 00 00 ff 01 01 chr ( )
00 00 00 00 00 00 00 00 00 00 aa 55 00 00 ff 01 02 chr ( )
00 00 00 00 00 00 00 00 00 00 aa aa 00 00 ff 01 03 chr ( )
00 00 00 00 00 00 00 00 00 00 00 22 00 00 ff 01 04 chr ( )
00 00 00 aa 55 aa 55 aa 55 aa 55 aa 55 aa ff 01 05 chr ( )
55 aa 55 aa 55 aa 55 aa 55 aa 55 00 00 00 ff 01 06 chr ( )
55 aa 55 aa 55 aa 55 aa 55 aa 55 aa 55 aa ff 01 07 chr ( )
00 00 00 00 00 00 aa 55 aa 00 00 00 00 00 ff 01 08 chr ( )
00 00 00 50 28 14 aa 55 aa 14 28 50 00 00 ff 01 09 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 0a chr ( )
00 00 00 00 aa 55 aa 55 aa 55 aa 55 00 00 ff 01 0b chr ( )
00 00 00 00 00 00 00 00 00 aa aa aa 00 00 ff 01 0c chr ( )
00 00 00 00 06 06 06 36 66 fe fc 60 30 00 ff 01 0d chr ( )
00 00 00 00 00 00 00 00 00 00 00 22 00 00 ff 01 0e chr ( )
ff ff ff ff ff ff ff 00 00 aa aa aa 00 00 ff 01 0f chr ( )
00 00 3c 66 66 66 66 66 3c 00 00 00 00 00 ff 01 10 chr ( )
00 00 18 38 58 18 18 18 7e 00 00 00 00 00 ff 01 11 chr ( )
00 00 3c 66 66 0c 38 62 7e 00 00 00 00 00 ff 01 12 chr ( )
00 00 3c 66 06 1c 06 66 3c 00 00 00 00 00 ff 01 13 chr ( )
00 00 0e 16 36 66 7f 06 06 00 00 00 00 00 ff 01 14 chr ( )
00 00 7e 60 7c 46 06 66 3c 00 00 00 00 00 ff 01 15 chr ( )
00 00 1c 30 60 7c 66 66 3c 00 00 00 00 00 ff 01 16 chr ( )
00 00 7e 7e 44 08 18 18 18 00 00 00 00 00 ff 01 17 chr ( )
00 00 3c 66 66 3c 66 66 3c 00 00 00 00 00 ff 01 18 chr ( )
00 00 3c 66 66 3e 06 0c 38 00 00 00 00 00 ff 01 19 chr ( )
00 00 00 0c 1e 1c 1c 0c 0e 07 03 00 00 00 ff ff 1a chr ( )
00 00 00 00 00 00 00 00 20 f0 f0 e0 00 00 ff ff 1b chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 1c chr ( )
00 00 00 00 00 00 aa 55 aa 00 00 00 00 00 ff 01 1d chr ( )
00 00 41 41 41 41 7f 41 41 41 41 00 00 00 ff 01 1e chr ( )
00 00 14 14 14 7f 14 7f 14 14 14 00 00 00 ff 01 1f chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 20 chr ( )
00 00 00 08 08 08 08 08 00 08 08 00 00 00 ff 01 21 chr ( ! )
00 00 00 24 24 24 00 00 00 00 00 00 00 00 ff 01 22 chr ( " )
00 00 00 12 12 7f 24 24 fe 48 48 00 00 00 ff 01 23 chr ( # )
00 00 08 08 3c 42 40 3c 02 42 3c 10 10 00 d7 01 24 chr ( $ )
00 00 00 60 92 94 68 16 29 49 06 00 00 00 ff 01 25 chr ( % )
00 00 00 18 24 20 31 51 4a 44 3b 00 00 00 ff 01 26 chr ( & )
00 00 00 08 08 08 00 00 00 00 00 00 00 00 ff 01 27 chr ( ' )
00 00 04 08 08 10 10 10 10 10 10 08 08 04 e9 01 28 chr ( ( )
00 00 20 10 10 08 08 08 08 08 08 10 10 20 97 01 29 chr ( )
00 00 08 2a 1c 2a 08 00 00 00 00 00 00 00 ff 01 2a chr ( * )
00 00 00 00 00 08 08 3e 08 08 00 00 00 00 ff 01 2b chr ( + )
00 00 00 00 00 00 00 00 00 08 08 08 10 00 d3 01 2c chr ( , )
00 00 00 00 00 00 00 7e 00 00 00 00 00 00 ff 01 2d chr ( - )
00 00 00 00 00 00 00 00 00 08 08 00 00 00 ff 01 2e chr ( . )
00 00 02 02 04 04 08 08 10 10 20 20 00 00 ff 01 2f chr ( / )
00 00 00 1c 22 22 22 22 22 22 1c 00 00 00 ff 01 30 chr ( 0 )
00 00 00 08 18 28 08 08 08 08 3e 00 00 00 ff 01 31 chr ( 1 )
00 00 00 1c 22 22 04 08 10 22 3e 00 00 00 ff 01 32 chr ( 2 )
00 00 00 1c 22 02 0c 02 02 22 1c 00 00 00 ff 01 33 chr ( 3 )
00 00 00 02 06 0a 12 22 3f 02 02 00 00 00 ff 01 34 chr ( 4 )
00 00 00 3e 20 3c 22 02 02 22 1c 00 00 00 ff 01 35 chr ( 5 )
00 00 00 0c 10 20 3c 22 22 22 1c 00 00 00 ff 01 36 chr ( 6 )
00 00 00 3e 22 04 04 08 08 08 08 00 00 00 ff 01 37 chr ( 7 )
00 00 00 1c 22 22 1c 22 22 22 1c 00 00 00 ff 01 38 chr ( 8 )
00 00 00 1c 22 22 22 1e 02 04 18 00 00 00 ff 01 39 chr ( 9 )
00 00 00 00 00 08 08 00 00 08 08 00 00 00 ff 01 3a chr ( : )
00 00 00 00 00 08 08 00 00 08 08 08 10 00 d3 01 3b chr ( ; )
00 00 00 00 00 06 18 60 18 06 00 00 00 00 ff 01 3c chr ( < )
00 00 00 00 00 00 7e 00 7e 00 00 00 00 00 ff 01 3d chr ( = )
00 00 00 00 00 60 18 06 18 60 00 00 00 00 ff 01 3e chr ( > )
00 00 00 1c 22 22 04 08 00 08 08 00 00 00 ff 01 3f chr ( ? )
00 00 3c 42 81 9d a5 a5 9a 80 40 3e 00 00 ff 01 40 chr ( @ )
00 00 00 18 18 24 24 42 7e 42 42 00 00 00 ff 00 41 chr ( A )
00 00 00 7c 42 42 7c 42 42 42 7c 00 00 00 ff 00 42 chr ( B )
00 00 00 1c 22 40 40 40 40 22 1c 00 00 00 ff 00 43 chr ( C )
00 00 00 78 44 42 42 42 42 44 78 00 00 00 ff 00 44 chr ( D )
00 00 00 3e 20 20 3c 20 20 20 3e 00 00 00 ff 00 45 chr ( E )
00 00 00 3e 20 20 3c 20 20 20 20 00 00 00 ff 00 46 chr ( F )
00 00 00 1c 22 40 40 4f 42 22 1e 00 00 00 ff 00 47 chr ( G )
00 00 00 42 42 42 7e 42 42 42 42 00 00 00 ff 00 48 chr ( H )
00 00 00 1c 08 08 08 08 08 08 1c 00 00 00 ff 00 49 chr ( I )
00 00 00 0e 04 04 04 04 44 44 38 00 00 00 ff 00 4a chr ( J )
00 00 00 22 24 28 30 28 24 22 21 00 00 00 ff 00 4b chr ( K )
00 00 00 20 20 20 20 20 20 20 3e 00 00 00 ff 00 4c chr ( L )
00 00 00 41 63 63 55 55 49 49 41 00 00 00 ff 00 4d chr ( M )
00 00 00 62 62 52 52 4a 4a 46 46 00 00 00 ff 00 4e chr ( N )
00 00 00 1c 22 41 41 41 41 22 1c 00 00 00 ff 00 4f chr ( O )
00 00 00 7c 42 42 42 7c 40 40 40 00 00 00 ff 00 50 chr ( P )
00 00 00 1c 22 41 41 41 41 22 1c 23 00 00 ff 00 51 chr ( Q )
00 00 00 7c 42 42 42 7c 48 44 42 00 00 00 ff 00 52 chr ( R )
00 00 00 3c 42 40 30 0c 02 42 3c 00 00 00 ff 00 53 chr ( S )
00 00 00 7f 08 08 08 08 08 08 08 00 00 00 ff 00 54 chr ( T )
00 00 00 42 42 42 42 42 42 42 3c 00 00 00 ff 00 55 chr ( U )
00 00 00 42 42 42 24 24 24 18 18 00 00 00 ff 00 56 chr ( V )
00 00 00 41 41 49 49 55 36 22 22 00 00 00 ff 00 57 chr ( W )
00 00 00 42 42 24 18 18 24 42 42 00 00 00 ff 00 58 chr ( X )
00 00 00 42 42 24 18 08 08 08 08 00 00 00 ff 00 59 chr ( Y )
00 00 00 7e 02 04 08 10 20 40 7e 00 00 00 ff 00 5a chr ( Z )
00 00 1c 10 10 10 10 10 10 10 10 10 10 1c d1 01 5b chr ( [ )
00 00 20 20 10 10 08 08 04 04 02 02 00 00 ff 01 5c chr ( \ )
00 00 38 08 08 08 08 08 08 08 08 08 08 38 8b 01 5d chr ( ] )
00 00 18 24 42 00 00 00 00 00 00 00 00 00 ff 01 5e chr ( ^ )
00 00 00 00 00 00 00 00 00 00 00 00 ff 00 ff 01 5f chr ( _ )
00 00 00 10 10 08 00 00 00 00 00 00 00 00 ff 01 60 chr ( ` )
00 00 00 00 00 3c 02 3e 42 46 3b 00 00 00 ff 01 61 chr ( a )
00 00 40 40 40 5c 62 42 42 42 7c 00 00 00 ff 00 62 chr ( b )
00 00 00 00 00 3c 42 40 40 42 3c 00 00 00 ff 01 63 chr ( c )
00 00 02 02 02 3e 42 42 42 46 3a 00 00 00 ff 00 64 chr ( d )
00 00 00 00 00 3c 42 7e 40 42 3c 00 00 00 ff 01 65 chr ( e )
00 00 0e 11 10 7e 10 10 10 10 10 00 00 00 ff 00 66 chr ( f )
00 00 00 00 00 3e 42 42 42 46 3a 02 42 3c 42 01 67 chr ( g )
00 00 40 40 40 5c 62 42 42 42 42 00 00 00 ff 00 68 chr ( h )
00 00 08 08 00 38 08 08 08 08 08 00 00 00 ff 01 69 chr ( i )
00 00 04 04 00 3c 04 04 04 04 04 04 44 38 45 01 6a chr ( j )
00 00 40 40 40 44 48 70 48 44 42 00 00 00 ff 00 6b chr ( k )
00 00 38 08 08 08 08 08 08 08 08 00 00 00 ff 00 6c chr ( l )
00 00 00 00 00 76 49 49 49 49 49 00 00 00 ff 01 6d chr ( m )
00 00 00 00 00 5c 62 42 42 42 42 00 00 00 ff 01 6e chr ( n )
00 00 00 00 00 3c 42 42 42 42 3c 00 00 00 ff 01 6f chr ( o )
00 00 00 00 00 5c 62 42 42 42 7c 40 40 40 5f 01 70 chr ( p )
00 00 00 00 00 3a 46 42 42 46 3a 02 02 02 fa 01 71 chr ( q )
00 00 00 00 00 2e 32 20 20 20 20 00 00 00 ff 01 72 chr ( r )
00 00 00 00 00 3c 42 30 0c 42 3c 00 00 00 ff 01 73 chr ( s )
00 00 00 10 10 7e 10 10 10 12 0c 00 00 00 ff 00 74 chr ( t )
00 00 00 00 00 42 42 42 42 46 3a 00 00 00 ff 01 75 chr ( u )
00 00 00 00 00 42 42 24 24 18 18 00 00 00 ff 01 76 chr ( v )
00 00 00 00 00 41 49 49 55 36 22 00 00 00 ff 01 77 chr ( w )
00 00 00 00 00 42 24 18 18 24 42 00 00 00 ff 01 78 chr ( x )
00 00 00 00 00 42 42 24 24 18 08 10 10 60 17 01 79 chr ( y )
00 00 00 00 00 7e 04 08 10 20 7e 00 00 00 ff 01 7a chr ( z )
00 00 0c 10 10 10 10 60 10 10 10 10 10 0c d1 01 7b chr ( { )
08 08 08 08 08 08 08 08 08 08 08 08 08 08 eb 01 7c chr ( | )
00 00 30 08 08 08 08 06 08 08 08 08 08 30 8b 01 7d chr ( } )
00 00 00 00 00 00 32 4c 00 00 00 00 00 00 ff 01 7e chr ( ~ )
00 00 00 00 18 18 24 24 42 42 7e 00 00 00 ff 01 7f chr ( )
00 00 00 1c 22 40 40 40 40 22 1c 08 30 00 b3 00 80 chr ( )
00 00 00 00 08 08 3e 08 08 00 3e 00 00 00 ff 01 81 chr ( )
14 14 14 14 14 14 14 14 14 14 14 14 14 14 d5 01 82 chr ( )
00 00 02 1e 26 45 49 49 51 32 3c 20 00 00 ff 00 83 chr ( )
00 00 00 00 04 3c 4a 4a 52 52 3c 20 00 00 ff 01 84 chr ( )
00 00 38 44 44 48 44 42 42 42 4c 00 00 00 ff 01 85 chr ( )
00 00 18 24 18 3c 02 3e 42 46 3b 00 00 00 ff 01 86 chr ( )
00 00 00 00 00 3c 42 40 40 42 3c 08 30 00 b3 01 87 chr ( )
00 00 00 20 20 22 22 20 20 20 3e 00 00 00 ff 00 88 chr ( )
00 00 70 10 10 12 12 10 10 10 10 00 00 00 ff 01 89 chr ( )
00 00 70 48 70 48 72 04 08 13 23 00 00 00 ff 01 8a chr ( )
00 00 00 e0 90 93 e4 96 93 91 e6 00 00 00 ff 01 8b chr ( )
00 00 00 80 80 ac 32 22 22 22 22 00 00 00 ff 01 8c chr ( )
00 00 80 a2 b2 32 2a 2a 26 26 22 00 00 00 ff 01 8d chr ( )
00 00 18 24 24 24 24 28 30 d2 0c 00 00 00 ff 01 8e chr ( )
00 18 24 18 18 24 24 42 7e 42 42 00 00 00 ff 00 8f chr ( )
00 00 18 24 24 18 00 00 00 00 00 00 00 00 ff 01 90 chr ( )
00 00 00 00 00 36 09 3f 48 49 3e 00 00 00 ff 01 91 chr ( )
00 00 00 1f 18 28 2e 48 78 88 8f 00 00 00 ff 00 92 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 93 chr ( )
00 00 00 36 74 74 74 34 14 14 14 00 00 00 ff 01 94 chr ( )
00 00 00 3c 42 20 58 44 22 1a 04 42 3c 00 3c 01 95 chr ( )
00 20 60 20 20 72 04 08 10 26 09 06 09 06 e9 01 96 chr ( )
00 70 08 30 08 72 04 08 10 26 09 06 09 06 e9 01 97 chr ( )
00 78 40 70 08 72 04 08 10 26 09 06 09 06 e9 01 98 chr ( )
00 70 08 30 08 72 04 08 10 23 05 09 0f 01 ef 01 99 chr ( )
00 78 08 10 20 22 04 08 10 26 09 06 09 06 e9 01 9a chr ( )
00 00 00 08 08 3c 42 40 40 42 3c 10 10 00 ff 01 9b chr ( )
00 00 00 1c 22 20 7c 20 20 22 5c 00 00 00 ff 01 9c chr ( )
00 00 00 22 22 14 3e 08 3e 08 08 00 00 00 ff 01 9d chr ( )
00 00 00 70 4a 4a 4f 72 42 42 43 00 00 00 ff 01 9e chr ( )
00 00 06 08 08 3c 10 10 10 10 20 20 40 00 4f 01 9f chr ( )
00 00 f1 5b 55 55 51 00 00 00 00 00 00 00 ff 01 a0 chr ( )
00 3c 42 b9 a5 b9 a5 42 3c 00 00 00 00 00 ff 01 a1 chr ( )
00 3c 42 99 a1 a1 99 42 3c 00 00 00 00 00 ff 01 a2 chr ( )
00 00 08 08 3e 08 08 08 08 00 00 00 00 00 ff 01 a3 chr ( )
00 00 1c 22 02 1c 20 3e 00 00 00 00 00 00 ff 01 a4 chr ( )
00 00 1c 22 0c 02 22 1c 00 00 00 00 00 00 ff 01 a5 chr ( )
00 00 00 38 04 3c 44 3c 00 7c 00 00 00 00 ff 01 a6 chr ( )
00 00 00 38 44 44 44 38 00 7c 00 00 00 00 ff 01 a7 chr ( )
00 00 00 00 08 08 00 08 10 22 22 1c 00 00 ff 01 a8 chr ( )
00 00 00 00 08 08 00 3e 00 08 08 00 00 00 ff 01 a9 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 aa chr ( )
00 20 60 20 20 72 04 08 10 2e 01 06 08 0f e8 01 ab chr ( )
00 20 60 20 20 72 04 08 10 23 05 09 0f 01 ef 01 ac chr ( )
00 00 00 00 08 08 00 08 08 08 08 08 00 00 ff 01 ad chr ( )
00 00 00 00 00 12 24 48 24 12 00 00 00 00 ff 01 ae chr ( )
00 00 00 00 00 48 24 12 24 48 00 00 00 00 ff 01 af chr ( )
00 04 08 10 00 00 00 00 00 00 00 00 00 00 ff 01 b0 chr ( )
00 20 10 08 00 00 00 00 00 00 00 00 00 00 ff 01 b1 chr ( )
00 18 24 42 00 00 00 00 00 00 00 00 00 00 ff 01 b2 chr ( )
00 00 24 24 00 00 00 00 00 00 00 00 00 00 ff 01 b3 chr ( )
00 00 00 00 00 00 00 00 00 00 ff 00 ff 00 ff 01 b4 chr ( )
00 00 55 00 55 00 55 00 55 00 55 00 00 00 ff 01 b5 chr ( )
00 00 32 4c 00 00 00 00 00 00 00 00 00 00 ff 01 b6 chr ( )
00 00 00 00 00 00 00 ff 00 00 00 00 00 00 ff 01 b7 chr ( )
00 00 3c 42 00 00 00 00 00 00 00 00 00 00 ff 01 b8 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 b9 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 ba chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bb chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bc chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bd chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 be chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bf chr ( )
0c 30 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c0 chr ( )
30 0c 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c1 chr ( )
18 24 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c2 chr ( )
24 24 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c3 chr ( )
00 00 00 00 00 00 00 00 00 00 ff 00 ff 00 ff 01 c4 chr ( )
00 00 55 00 55 00 55 00 55 00 55 00 00 00 ff 01 c5 chr ( )
32 4c 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c6 chr ( )
00 00 00 00 00 00 00 ff 00 00 00 00 00 00 ff 01 c7 chr ( )
3c 42 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c8 chr ( )
b1 6b 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c9 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 ca chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 cb chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 cc chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 cd chr ( )
00 00 00 00 00 aa 55 aa 55 aa 55 aa 55 aa ff 01 ce chr ( )
ff ff 55 aa 55 aa 55 aa 55 aa 55 aa 55 00 ff 01 cf chr ( )
maxi here to ( allot the font )
( BOLD font )
code boldfont nx ) jsr, ;c ( define font table )
here maxi to
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 00 00 chr ( )
00 00 00 00 00 7e 7e 00 00 00 00 00 00 00 ff 01 01 chr ( )
00 00 00 00 00 00 00 00 00 00 aa 55 00 00 ff 01 02 chr ( )
00 00 00 00 00 00 00 00 00 00 55 55 00 00 ff 01 03 chr ( )
00 00 00 00 00 00 00 00 00 00 00 22 00 00 ff 01 04 chr ( )
00 00 00 00 aa 55 aa 55 aa 55 aa 55 aa 55 ff 01 05 chr ( )
aa 55 aa 55 aa 55 aa 55 aa 55 aa 55 00 00 ff 01 06 chr ( )
aa 55 aa 55 aa 55 aa 55 aa 55 aa 55 aa 55 ff 01 07 chr ( )
00 00 00 00 00 00 aa 55 aa 00 00 00 00 00 ff 01 08 chr ( )
00 00 00 50 28 14 aa 55 aa 14 28 50 00 00 ff 01 09 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 0a chr ( )
00 00 00 00 aa 55 aa 55 aa 55 aa 55 00 00 ff 01 0b chr ( )
00 00 00 00 00 00 00 00 00 55 55 55 00 00 ff 01 0c chr ( )
00 00 00 06 06 06 06 36 66 fe fc 60 30 00 ff 01 0d chr ( )
00 00 00 00 00 00 00 00 00 00 00 22 00 00 ff 01 0e chr ( )
ff ff ff ff ff ff ff 00 00 55 55 55 00 00 ff 01 0f chr ( )
00 00 3c 66 66 66 66 66 3c 00 00 00 00 00 ff 01 10 chr ( )
00 00 18 38 58 18 18 18 7e 00 00 00 00 00 ff 01 11 chr ( )
00 00 3c 66 66 0c 38 62 7e 00 00 00 00 00 ff 01 12 chr ( )
00 00 3c 66 06 1c 06 66 3c 00 00 00 00 00 ff 01 13 chr ( )
00 00 0e 16 36 66 7f 06 06 00 00 00 00 00 ff 01 14 chr ( )
00 00 7e 60 7c 46 06 66 3c 00 00 00 00 00 ff 01 15 chr ( )
00 00 1c 30 60 7c 66 66 3c 00 00 00 00 00 ff 01 16 chr ( )
00 00 7e 7e 44 08 18 18 18 00 00 00 00 00 ff 01 17 chr ( )
00 00 3c 66 66 3c 66 66 3c 00 00 00 00 00 ff 01 18 chr ( )
00 00 3c 66 66 3e 06 0c 38 00 00 00 00 00 ff 01 19 chr ( )
00 00 00 0c 1e 1c 1c 0c 0e 07 03 00 00 00 ff ff 1a chr ( )
00 00 00 00 00 00 00 00 20 f0 f0 e0 00 00 ff ff 1b chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 1c chr ( )
00 00 00 00 00 00 aa 55 aa 00 00 00 00 00 ff 01 1d chr ( )
00 00 63 63 63 63 7f 63 63 63 63 00 00 00 ff 01 1e chr ( )
00 00 66 66 66 7f 66 7f 66 66 66 00 00 00 ff 01 1f chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 20 chr ( )
00 00 00 18 18 18 18 18 00 18 18 00 00 00 ff 01 21 chr ( ! )
00 00 00 36 36 24 00 00 00 00 00 00 00 00 ff 01 22 chr ( " )
00 00 00 1b 1b 7f 36 36 ff 6c 6c 00 00 00 ff 01 23 chr ( # )
00 00 08 08 3c 66 70 3c 0e 66 3c 10 10 00 d7 01 24 chr ( $ )
00 00 00 70 d8 d6 6c 18 36 6b 1b 0e 00 00 ff 01 25 chr ( % )
00 00 00 3c 64 60 33 d9 ce c6 7b 00 00 00 ff 01 26 chr ( & )
00 00 00 18 18 10 00 00 00 00 00 00 00 00 ff 01 27 chr ( ' )
00 00 0c 18 18 30 30 30 30 30 30 18 18 0c db 01 28 chr ( ( )
00 00 30 18 18 0c 0c 0c 0c 0c 0c 18 18 30 db 01 29 chr ( )
00 00 18 7e 3c 7e 18 00 00 00 00 00 00 00 ff 01 2a chr ( * )
00 00 00 00 18 18 7e 18 18 00 00 00 00 00 ff 01 2b chr ( + )
00 00 00 00 00 00 00 00 00 18 18 18 30 00 b7 01 2c chr ( , )
00 00 00 00 00 00 7e 7e 00 00 00 00 00 00 ff 01 2d chr ( - )
00 00 00 00 00 00 00 00 00 18 18 00 00 00 ff 01 2e chr ( . )
00 00 06 06 0c 0c 18 18 30 30 60 60 00 00 ff 01 2f chr ( / )
00 00 00 3c 66 66 66 66 66 66 3c 00 00 00 ff 01 30 chr ( 0 )
00 00 00 18 38 58 18 18 18 18 7e 00 00 00 ff 01 31 chr ( 1 )
00 00 00 3c 66 66 0c 18 30 62 7e 00 00 00 ff 01 32 chr ( 2 )
00 00 00 3c 66 06 1c 06 06 66 3c 00 00 00 ff 01 33 chr ( 3 )
00 00 00 06 0e 1e 36 66 7f 06 06 00 00 00 ff 01 34 chr ( 4 )
00 00 00 7e 60 7c 46 06 06 66 3c 00 00 00 ff 01 35 chr ( 5 )
00 00 00 1c 30 60 7c 66 66 66 3c 00 00 00 ff 01 36 chr ( 6 )
00 00 00 7e 7e 44 0c 08 18 18 18 00 00 00 ff 01 37 chr ( 7 )
00 00 00 3c 66 66 3c 66 66 66 3c 00 00 00 ff 01 38 chr ( 8 )
00 00 00 3c 66 66 66 3e 06 0c 38 00 00 00 ff 01 39 chr ( 9 )
00 00 00 00 00 18 18 00 00 18 18 00 00 00 ff 01 3a chr ( : )
00 00 00 00 00 18 18 00 00 18 18 18 30 00 b7 01 3b chr ( ; )
00 00 00 00 00 07 1c 70 1c 07 00 00 00 00 ff 01 3c chr ( < )
00 00 00 00 00 7e 7e 00 7e 7e 00 00 00 00 ff 01 3d chr ( = )
00 00 00 00 00 70 1c 07 1c 70 00 00 00 00 ff 01 3e chr ( > )
00 00 00 3c 66 66 0c 18 00 18 18 00 00 00 ff 01 3f chr ( ? )
00 00 3c 42 81 bd ed ed b6 80 40 3e 00 00 ff 01 40 chr ( @ )
00 00 00 18 18 2c 2c 66 7e 66 66 00 00 00 ff 00 41 chr ( A )
00 00 00 7c 66 66 7c 66 66 66 7c 00 00 00 ff 00 42 chr ( B )
00 00 00 1e 33 60 60 60 60 33 1e 00 00 00 ff 00 43 chr ( C )
00 00 00 7c 66 63 63 63 63 66 7c 00 00 00 ff 00 44 chr ( D )
00 00 00 7e 60 60 7c 60 60 60 7e 00 00 00 ff 00 45 chr ( E )
00 00 00 7e 60 60 7c 60 60 60 60 00 00 00 ff 00 46 chr ( F )
00 00 00 1e 33 60 60 67 63 33 1f 00 00 00 ff 00 47 chr ( G )
00 00 00 66 66 66 7e 66 66 66 66 00 00 00 ff 00 48 chr ( H )
00 00 00 3c 18 18 18 18 18 18 3c 00 00 00 ff 00 49 chr ( I )
00 00 00 0e 06 06 06 06 66 66 3c 00 00 00 ff 00 4a chr ( J )
00 00 00 66 6c 78 70 78 6c 66 63 00 00 00 ff 00 4b chr ( K )
00 00 00 60 60 60 60 60 60 60 7e 00 00 00 ff 00 4c chr ( L )
00 00 00 63 63 77 77 5b 5b 43 43 00 00 00 ff 00 4d chr ( M )
00 00 00 62 72 72 5a 5a 4e 4e 46 00 00 00 ff 00 4e chr ( N )
00 00 00 1c 36 63 63 63 63 36 1c 00 00 00 ff 00 4f chr ( O )
00 00 00 7c 66 66 66 7c 60 60 60 00 00 00 ff 00 50 chr ( P )
00 00 00 1c 36 63 63 63 63 36 1c 37 00 00 ff 00 51 chr ( Q )
00 00 00 7c 66 66 66 7c 6c 66 63 00 00 00 ff 00 52 chr ( R )
00 00 00 3c 66 60 7c 3e 06 66 3c 00 00 00 ff 00 53 chr ( S )
00 00 00 7e 18 18 18 18 18 18 18 00 00 00 ff 00 54 chr ( T )
00 00 00 66 66 66 66 66 66 66 3c 00 00 00 ff 00 55 chr ( U )
00 00 00 66 66 66 34 34 34 18 18 00 00 00 ff 00 56 chr ( V )
00 00 00 61 61 6d 6d 6d 76 36 36 00 00 00 ff 00 57 chr ( W )
00 00 00 66 66 34 18 18 2c 66 66 00 00 00 ff 00 58 chr ( X )
00 00 00 66 66 34 34 18 18 18 18 00 00 00 ff 00 59 chr ( Y )
00 00 00 7e 06 0e 1c 38 70 60 7e 00 00 00 ff 00 5a chr ( Z )
00 00 3c 30 30 30 30 30 30 30 30 30 30 3c b1 01 5b chr ( [ )
00 00 60 60 30 30 18 18 0c 0c 06 06 00 00 ff 01 5c chr ( \ )
00 00 3c 0c 0c 0c 0c 0c 0c 0c 0c 0c 0c 3c 8d 01 5d chr ( ] )
00 00 00 18 3c 66 42 00 00 00 00 00 00 00 ff 01 5e chr ( ^ )
00 00 00 00 00 00 00 00 00 00 00 00 ff 00 ff 01 5f chr ( _ )
00 00 00 30 30 18 08 00 00 00 00 00 00 00 ff 01 60 chr ( ` )
00 00 00 00 00 3c 06 3e 66 66 3b 00 00 00 ff 01 61 chr ( a )
00 00 60 60 60 6c 76 66 66 66 7c 00 00 00 ff 00 62 chr ( b )
00 00 00 00 00 3c 66 60 60 66 3c 00 00 00 ff 01 63 chr ( c )
00 00 06 06 06 3e 66 66 66 6e 36 00 00 00 ff 00 64 chr ( d )
00 00 00 00 00 3c 66 7e 60 66 3c 00 00 00 ff 01 65 chr ( e )
00 00 1e 32 30 7c 30 30 30 30 30 00 00 00 ff 00 66 chr ( f )
00 00 00 00 00 3e 66 66 66 6e 36 06 66 3c 66 01 67 chr ( g )
00 00 60 60 60 6c 76 66 66 66 66 00 00 00 ff 00 68 chr ( h )
00 00 18 18 00 38 18 18 18 18 18 00 00 00 ff 01 69 chr ( i )
00 00 0c 0c 00 3c 0c 0c 0c 0c 0c 0c cc 78 cd 01 6a chr ( j )
00 00 60 60 60 66 6c 78 6c 66 63 00 00 00 ff 00 6b chr ( k )
00 00 38 18 18 18 18 18 18 18 18 00 00 00 ff 00 6c chr ( l )
00 00 00 00 00 ee db db db db db 00 00 00 ff 01 6d chr ( m )
00 00 00 00 00 6c 76 66 66 66 66 00 00 00 ff 01 6e chr ( n )
00 00 00 00 00 3c 66 66 66 66 3c 00 00 00 ff 01 6f chr ( o )
00 00 00 00 00 6c 76 66 66 66 7c 60 60 60 6f 01 70 chr ( p )
00 00 00 00 00 3a 66 66 66 6e 36 06 06 06 f6 01 71 chr ( q )
00 00 00 00 00 36 36 38 30 30 30 00 00 00 ff 01 72 chr ( r )
00 00 00 00 00 3e 60 78 1e 06 7c 00 00 00 ff 01 73 chr ( s )
00 00 00 30 30 7c 30 30 30 32 1c 00 00 00 ff 00 74 chr ( t )
00 00 00 00 00 66 66 66 66 6e 36 00 00 00 ff 01 75 chr ( u )
00 00 00 00 00 66 66 34 34 18 18 00 00 00 ff 01 76 chr ( v )
00 00 00 00 00 6d 6d 6d 36 36 36 00 00 00 ff 01 77 chr ( w )
00 00 00 00 00 63 36 1c 1c 36 63 00 00 00 ff 01 78 chr ( x )
00 00 00 00 00 66 66 34 34 18 18 10 30 60 b7 01 79 chr ( y )
00 00 00 00 00 7e 0c 18 30 60 7e 00 00 00 ff 01 7a chr ( z )
00 00 0e 18 18 18 18 70 18 18 18 18 18 0e d8 01 7b chr ( { )
18 18 18 18 18 18 18 18 18 18 18 18 18 18 db 01 7c chr ( | )
00 00 70 18 18 18 18 0e 18 18 18 18 18 70 1b 01 7d chr ( } )
00 00 00 00 00 00 3a 5c 00 00 00 00 00 00 ff 01 7e chr ( ~ )
00 00 00 00 18 18 3c 24 66 42 7e 00 00 00 ff 01 7f chr ( )
00 00 00 1e 33 60 60 60 60 33 1e 0c 38 00 bb 00 80 chr ( )
00 00 00 00 18 18 7e 18 18 00 7e 00 00 00 ff 01 81 chr ( )
36 36 36 36 36 36 36 36 36 36 36 36 36 36 b6 01 82 chr ( )
00 00 02 1e 36 67 6b 6b 73 36 3c 20 00 00 ff 00 83 chr ( )
00 00 00 00 04 3c 6e 6e 76 76 3c 20 00 00 ff 01 84 chr ( )
00 00 3c 66 66 6c 66 63 63 63 6e 00 00 00 ff 01 85 chr ( )
00 00 1c 36 1c 3c 06 3e 66 66 3b 00 00 00 ff 01 86 chr ( )
00 00 00 00 00 3c 66 60 60 66 3c 18 30 00 b7 01 87 chr ( )
00 00 00 60 60 66 66 60 60 60 7e 00 00 00 ff 00 88 chr ( )
00 00 70 30 30 36 36 30 30 30 30 00 00 00 ff 01 89 chr ( )
00 00 f0 d8 f0 db f6 0c 18 33 63 00 00 00 ff 01 8a chr ( )
00 00 00 f0 d8 db f6 de db db f6 00 00 00 ff 01 8b chr ( )
00 00 00 c0 c0 b6 3b 33 33 33 33 00 00 00 ff 01 8c chr ( )
00 00 c0 f2 b2 3a 3a 2e 2e 26 26 00 00 00 ff 01 8d chr ( )
00 00 18 34 34 34 34 34 18 ed 06 00 00 00 ff 01 8e chr ( )
00 1c 36 1c 18 2c 2c 66 7e 66 66 00 00 00 ff 00 8f chr ( )
00 00 1c 36 36 1c 00 00 00 00 00 00 00 00 ff 01 90 chr ( )
00 00 00 00 00 7e 1b 7f d8 db 7e 00 00 00 ff 01 91 chr ( )
00 00 00 1f 1c 2c 2f 6c 7c cc cf 00 00 00 ff 00 92 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 93 chr ( )
00 00 00 3b 7b 7b 7b 3b 0b 0b 0b 00 00 00 ff 01 94 chr ( )
00 00 00 3c 66 30 78 6c 36 1e 0c 66 3c 00 3c 01 95 chr ( )
00 60 e0 60 60 f6 0c 18 30 6e 1b 0e 1b 0e db 01 96 chr ( )
00 f0 18 70 18 f6 0c 18 30 6e 1b 0e 1b 0e db 01 97 chr ( )
00 f8 c0 f0 18 f6 0c 18 30 6e 1b 0e 1b 0e db 01 98 chr ( )
00 f0 18 70 18 f6 0c 18 30 67 0b 1b 1f 03 df 01 99 chr ( )
00 f8 18 30 60 66 0c 18 30 6e 1b 0e 1b 0e db 01 9a chr ( )
00 00 00 08 08 3c 66 60 60 66 3c 10 10 00 ff 01 9b chr ( )
00 00 00 1e 33 30 7c 30 30 33 7e 00 00 00 ff 01 9c chr ( )
00 00 00 66 66 34 7e 18 7e 18 18 00 00 00 ff 01 9d chr ( )
00 00 00 f0 d8 d8 f6 c6 cf c6 c6 03 00 00 ff 01 9e chr ( )
00 00 07 0d 0c 3e 18 18 18 30 30 60 00 00 ff 01 9f chr ( )
00 00 fb 6f 6f 6b 6b 00 00 00 00 00 00 00 ff 01 a0 chr ( )
00 3c 42 b9 b5 b9 b5 42 3c 00 00 00 00 00 ff 01 a1 chr ( )
00 3c 42 9d b1 b1 9d 42 3c 00 00 00 00 00 ff 01 a2 chr ( )
00 00 18 18 7e 18 18 18 18 00 00 00 00 00 ff 01 a3 chr ( )
00 00 3c 66 06 1c 70 7e 00 00 00 00 00 00 ff 01 a4 chr ( )
00 00 3c 66 0c 06 66 3c 00 00 00 00 00 00 ff 01 a5 chr ( )
00 00 00 3c 06 3e 66 3e 00 7e 00 00 00 00 ff 01 a6 chr ( )
00 00 00 3c 66 66 66 3c 00 7e 00 00 00 00 ff 01 a7 chr ( )
00 00 00 00 18 18 00 18 30 66 66 3c 00 00 ff 01 a8 chr ( )
00 00 00 00 18 18 00 7e 00 18 18 00 00 00 ff 01 a9 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 aa chr ( )
00 60 e0 60 60 f6 0c 18 30 6e 03 06 0c 0f ec 01 ab chr ( )
00 60 e0 60 60 f6 0c 18 30 67 0b 1b 1f 03 df 01 ac chr ( )
00 00 00 00 18 18 00 18 18 18 18 18 00 00 ff 01 ad chr ( )
00 00 00 00 00 1b 36 6c 36 1b 00 00 00 00 ff 01 ae chr ( )
00 00 00 00 00 6c 36 1b 36 6c 00 00 00 00 ff 01 af chr ( )
00 06 0c 18 00 00 00 00 00 00 00 00 00 00 ff 01 b0 chr ( )
00 60 30 18 00 00 00 00 00 00 00 00 00 00 ff 01 b1 chr ( )
00 18 3c 66 00 00 00 00 00 00 00 00 00 00 ff 01 b2 chr ( )
00 00 66 66 00 00 00 00 00 00 00 00 00 00 ff 01 b3 chr ( )
00 00 00 00 00 00 00 00 00 00 ff 00 ff 00 ff 01 b4 chr ( )
00 00 55 00 55 00 55 00 55 00 55 00 00 00 ff 01 b5 chr ( )
00 00 3a 5c 00 00 00 00 00 00 00 00 00 00 ff 01 b6 chr ( )
00 00 00 00 00 00 00 ff 00 00 00 00 00 00 ff 01 b7 chr ( )
00 00 3c 66 00 00 00 00 00 00 00 00 00 00 ff 01 b8 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 b9 chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 ba chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bb chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bc chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bd chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 be chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 bf chr ( )
0e 38 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c0 chr ( )
70 1c 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c1 chr ( )
1c 36 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c2 chr ( )
66 66 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c3 chr ( )
00 00 00 00 00 00 00 00 00 00 ff 00 ff 00 ff 01 c4 chr ( )
00 00 55 00 55 00 55 00 55 00 55 00 00 00 ff 01 c5 chr ( )
3a 5c 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c6 chr ( )
00 00 00 00 00 00 00 ff 00 00 00 00 00 00 ff 01 c7 chr ( )
3c 66 00 00 00 00 00 00 00 00 00 00 00 00 ff 01 c8 chr ( )
fe fd fe fe fe fe fe fe fe fe fe 00 00 00 ff 01 c9 chr ( )
f7 f7 fe fb f7 fd f7 fe fd fe fd f7 fe fd ff 01 ca chr ( )
fc fd fb f9 f9 f7 f8 fd fb fb f9 f9 fc fb ff 01 cb chr ( )
fa fa fa fa fa fa fa fa fa fa fd fc fb fa ff 01 cc chr ( )
f7 fa fa fa f9 fa fa f9 f9 fb fa f9 fa f7 ff 01 cd chr ( )
fa f9 f9 fa f9 f9 f9 f9 f9 f9 fa fc fa fc ff 01 ce chr ( )
fc fa fa fa fa fa fb fa fa fd fc fa fc f9 ff 01 cf chr ( )
00 00 00 f8 0c 06 03 01 00 00 00 00 00 00 ff 00 d0 chr ( )
00 00 00 00 00 00 04 87 ff 07 04 00 00 00 ff 00 d1 chr ( )
00 00 00 00 00 00 00 0f cf 0f 00 00 00 00 ff 00 d2 chr ( )
00 00 00 00 00 10 18 08 0c 04 07 00 00 00 ff 00 d3 chr ( )
00 e6 e6 06 e6 e6 06 e6 e6 00 ff 00 00 00 ff 00 d4 chr ( )
00 00 00 00 00 08 18 10 30 20 e0 00 00 00 ff 00 d5 chr ( )
00 07 07 00 07 87 c0 47 67 20 3f 00 00 00 ff 00 d6 chr ( )
00 30 30 31 36 38 31 31 33 02 fe 00 00 00 ff 00 d7 chr ( )
00 10 1c ff 1c 10 80 00 00 00 00 00 00 00 ff 00 d8 chr ( )
00 1f 10 13 10 13 10 13 10 08 07 00 00 00 ff 00 d9 chr ( )
00 fc 04 e4 04 e4 04 e4 04 74 8c 00 00 00 ff 00 da chr ( )
00 00 00 02 06 0f 06 02 00 00 00 00 00 00 ff 00 db chr ( )
07 0d 18 32 03 ff 03 32 18 0d 07 00 00 00 ff 00 dc chr ( )
00 80 c0 60 30 98 30 60 c0 80 00 00 00 00 ff 00 dd chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 00 de chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 00 df chr ( )
00 00 00 02 0e 3f 0e 02 00 00 00 00 00 00 ff 00 e0 chr ( )
06 0f 19 30 00 fe 00 30 19 0f 06 00 00 00 ff 00 e1 chr ( )
00 00 80 c0 60 30 60 c0 80 00 00 00 00 00 ff 00 e2 chr ( )
00 30 63 63 3e 18 18 18 18 18 00 00 00 00 ff 00 e3 chr ( )
00 01 03 06 00 00 00 06 03 01 00 00 00 00 ff 00 e4 chr ( )
c0 e0 30 18 0c 06 0c 18 30 e0 c0 00 00 00 ff 00 e5 chr ( )
00 07 04 04 04 04 04 04 07 00 00 00 00 00 ff 00 e6 chr ( )
00 ff f9 f9 01 71 01 01 ff ff ff 00 00 00 ff 00 e7 chr ( )
00 00 00 e0 e0 e0 e0 e0 e0 e0 e0 00 00 00 ff 00 e8 chr ( )
00 07 08 11 20 40 20 11 08 07 00 00 00 00 ff 00 e9 chr ( )
00 ff 00 8c d8 70 d8 8c 00 ff 00 00 00 00 ff 00 ea chr ( )
00 81 83 86 80 80 80 86 83 81 00 00 00 00 ff 00 eb chr ( )
c0 e0 30 18 0c 06 0c 18 30 e0 c0 00 00 00 ff 00 ec chr ( )
00 00 77 77 00 77 77 00 77 77 00 00 00 00 ff 00 ed chr ( )
00 00 77 77 00 77 77 00 77 77 00 00 00 00 ff 00 ee chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 00 ef chr ( )
00 01 0c 60 00 36 00 60 0c 01 00 00 00 00 ff 00 f0 chr ( )
00 80 00 00 00 c0 00 00 00 80 00 00 00 00 ff 00 f1 chr ( )
00 0f 30 20 40 4f 4f 40 20 30 0f 00 00 00 ff 00 f2 chr ( )
00 e0 18 08 04 c4 c4 04 08 18 e0 00 00 00 ff 00 f3 chr ( )
00 00 00 00 00 00 00 00 00 61 61 00 00 00 ff 00 f4 chr ( )
00 00 00 00 00 00 00 00 00 86 86 00 00 00 ff 00 f5 chr ( )
00 1f 10 11 17 11 10 10 10 10 1f 00 00 00 ff 00 f6 chr ( )
00 ff 40 c0 ff c1 40 00 00 00 ff 00 00 00 ff 00 f7 chr ( )
00 ff 00 00 00 82 c3 7f 03 02 ff 00 00 00 ff 00 f8 chr ( )
00 f8 08 08 08 08 88 e8 88 08 f8 00 00 00 ff 00 f9 chr ( )
00 00 00 00 00 00 00 3e 22 22 3e 00 00 00 ff 00 fa chr ( )
00 7c 7c 7c 7c 00 00 7c 44 44 7c 00 00 00 ff 00 fb chr ( )
00 00 00 00 00 00 00 f8 88 88 f8 00 00 00 ff 00 fc chr ( )
00 00 07 00 07 00 07 00 07 00 07 00 00 00 ff 00 fd chr ( )
00 00 ff 00 ff 00 fe 00 f0 00 80 00 00 00 ff 00 fe chr ( )
00 00 f8 00 c0 00 00 00 00 00 00 00 00 00 ff 00 ff chr ( )
maxi here to ( allot the font)
( New from Scott 27 Mar 87 )
code rulerfont nx ) jsr, ;c
here maxi to
00 08 08 00 00 00 00 00 00 00 00 00 00 00 ff 00 00 chr ( )
00 08 08 08 08 08 00 00 00 00 00 00 00 00 ff 00 01 chr ( )
00 08 08 1c 3e 7f 00 00 00 00 00 00 00 00 ff 00 02 chr ( )
00 08 1c 3e 3e 1c 00 00 00 00 00 00 00 00 ff 00 03 chr ( )
01 09 09 01 01 01 01 01 01 01 01 01 01 01 ff 00 04 chr ( )
01 09 09 09 09 09 01 01 01 01 01 01 01 01 ff 00 05 chr ( )
00 08 08 00 00 00 00 80 80 80 80 80 80 80 ff 00 06 chr ( )
00 08 08 08 08 08 00 80 80 80 80 80 80 80 ff 00 07 chr ( )
80 88 88 80 80 80 80 80 00 00 00 00 00 00 ff 00 08 chr ( )
80 88 88 88 88 88 80 80 00 00 00 00 00 00 ff 00 09 chr ( )
80 88 88 80 80 80 80 80 80 80 80 80 80 80 ff 00 0a chr ( )
80 88 88 88 88 88 80 80 80 80 80 80 80 80 ff 00 0b chr ( )
00 00 3c 7e ff db ff ff e7 db 7e 3c 00 00 ff 00 0c chr ( )
00 07 0f 0f 0f 0f 0f 0f 0f 0f 0f 0f 07 00 ff 00 0d chr ( )
00 e0 f0 f0 f0 f0 f0 f0 f0 f0 f0 f0 e0 00 ff 00 0e chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 00 0f chr ( )
00 00 00 00 00 00 00 00 00 00 00 00 00 00 ff 00 10 chr ( )
00 00 00 00 00 00 00 00 00 08 38 08 08 3e ff 00 11 chr ( )
00 00 00 00 00 00 00 00 00 3c 02 1c 20 3e ff 00 12 chr ( )
00 00 00 00 00 00 00 00 00 3c 02 1c 02 3c ff 00 13 chr ( )
00 00 00 00 00 00 00 00 00 0c 14 24 3e 04 ff 00 14 chr ( )
00 00 00 00 00 00 00 00 00 3e 20 3c 02 3c ff 00 15 chr ( )
00 00 00 00 00 00 00 00 00 1c 20 3c 22 1c ff 00 16 chr ( )
00 00 00 00 00 00 00 00 00 3e 22 04 08 08 ff 00 17 chr ( )
00 00 00 00 00 00 00 00 00 1c 22 1c 22 1c ff 00 18 chr ( )
ff 81 81 81 81 81 81 81 81 81 81 81 81 ff ff 00 19 chr ( )
00 3f 40 5f 40 5f 40 5f 40 5f 40 40 3f 00 ff 00 1a chr ( )
00 3f 7f 60 7f 60 7f 60 7f 60 7f 7f 3f 00 ff 00 1b chr ( )
00 fc 02 fa 02 c2 02 e2 02 82 02 02 fc 00 ff 00 1c chr ( )
00 fc fe 06 fe 3e fe 1e fe 7e fe fe fc 00 ff 00 1d chr ( )
00 3f 40 5f 40 47 40 4f 40 43 40 40 3f 00 ff 00 1e chr ( )
00 3f 7f 40 7f 70 7f 60 7f 78 7f 7f 3f 00 ff 00 1f chr ( )
00 fc 02 fa 02 e2 02 f2 02 c2 02 02 fc 00 ff 00 20 chr ( )
00 fc fe 06 fe 1e fe 0e fe 3e fe fe fc 00 ff 00 21 chr ( ! )
00 3f 40 5f 40 43 40 47 40 41 40 40 3f 00 ff 00 22 chr ( " )
00 3f 7f 60 7f 7c 7f 78 7f 7e 7f 7f 3f 00 ff 00 23 chr ( # )
00 fc 02 fa 02 fa 02 fa 02 fa 02 02 fc 00 ff 00 24 chr ( $ )
00 fc fe 06 fe 06 fe 06 fe 06 fe fe fc 00 ff 00 25 chr ( % )
00 3f 40 4f 40 4f 40 4f 40 4f 40 40 3f 00 ff 00 26 chr ( & )
00 3f 7f 70 7f 70 7f 70 7f 70 7f 7f 3f 00 ff 00 27 chr ( ' )
00 fc 02 f2 02 f2 02 f2 02 f2 02 02 fc 00 ff 00 28 chr ( ( )
00 fc fe 0e fe 0e fe 0e fe 0e fe fe fc 00 ff 00 29 chr ( )
00 3f 40 41 43 45 41 41 41 41 47 40 3f 00 ff 00 2a chr ( * )
00 3f 7f 7e 7c 7a 7e 7e 7e 7e 78 7f 3f 00 ff 00 2b chr ( + )
00 fc 02 82 82 82 82 82 82 82 e2 02 fc 00 ff 00 2c chr ( , )
00 fc fe 7e 7e 7e 7e 7e 7e 7e 1e fe fc 00 ff 00 2d chr ( - )
00 3f 40 4c 5d 4c 4c 4c 4d 4c 5e 40 3f 00 ff 00 2e chr ( . )
00 3f 7f 73 62 73 73 73 72 73 61 7f 3f 00 ff 00 2f chr ( / )
00 fc 02 82 92 a2 c2 ba 0a 12 3a 02 fc 00 ff 00 30 chr ( 0 )
00 fc fe 7e 6e 5e 26 7a f6 ee e2 fe fc 00 ff 00 31 chr ( 1 )
00 3f 40 43 46 46 40 41 43 46 47 40 3f 00 ff 00 32 chr ( 2 )
00 3f 7f 7c 79 79 7f 7e 7c 79 78 7f 3f 00 ff 00 33 chr ( 3 )
00 fc 02 c2 62 62 c2 82 02 22 e2 02 fc 00 ff 00 34 chr ( 4 )
00 fc fe 3e 9e 9e 3e 7e fe de 1e fe fc 00 ff 00 35 chr ( 5 )
00 3f 40 47 41 41 41 41 41 41 47 40 3f 00 ff 00 36 chr ( 6 )
00 3f 7f 78 7e 7e 7e 7e 7e 7e 78 7f 3f 00 ff 00 37 chr ( 7 )
00 fc 02 e2 82 82 82 82 82 82 e2 02 fc 00 ff 00 38 chr ( 8 )
00 fc fe 1e 7e 7e 7e 7e 7e 7e 1e fe fc 00 ff 00 39 chr ( 9 )
00 3f 40 4f 46 46 46 46 46 46 4f 40 3f 00 ff 00 3a chr ( : )
00 3f 7f 70 79 79 79 79 79 79 70 7f 3f 00 ff 00 3b chr ( ; )
00 fc 02 fa 32 32 32 32 32 32 fa 02 fc 00 ff 00 3c chr ( < )
00 fc fe 06 ce ce ce ce ce ce 06 fe fc 00 ff 00 3d chr ( = )
01 09 09 1d 3f 7f 01 01 01 01 01 01 01 01 ff 00 3e chr ( > )
01 09 1d 3f 3f 1d 01 01 01 01 01 01 01 01 ff 00 3f chr ( ? )
00 08 08 1c 3e 7f 00 80 80 80 80 80 80 80 ff 00 40 chr ( @ )
00 08 1c 3e 3e 1c 00 80 80 80 80 80 80 80 ff 00 41 chr ( A )
80 88 88 9c be ff 80 80 00 00 00 00 00 00 ff 00 42 chr ( B )
80 88 9c be be 9c 80 80 00 00 00 00 00 00 ff 00 43 chr ( C )
80 88 88 9c be ff 80 80 80 80 80 80 80 80 ff 00 44 chr ( D )
80 88 9c be be 9c 80 80 80 80 80 80 80 80 ff 00 45 chr ( E )
00 00 00 f8 c0 c0 f1 c1 c1 c1 f9 00 00 00 ff 00 46 chr ( F )
00 00 00 1f 18 18 9e 98 98 98 98 00 00 00 ff 00 47 chr ( G )
00 00 00 00 00 00 ff 00 00 00 ff 00 00 00 ff 00 48 chr ( H )
00 00 00 00 00 00 ff 80 80 80 ff 00 00 00 ff 00 49 chr ( I )
00 00 00 00 00 00 ff c0 c0 c0 ff 00 00 00 ff 00 4a chr ( J )
00 00 00 00 00 00 ff e0 e0 e0 ff 00 00 00 ff 00 4b chr ( K )
00 00 00 00 00 00 ff f0 f0 f0 ff 00 00 00 ff 00 4c chr ( L )
00 00 00 00 00 00 ff f8 f8 f8 ff 00 00 00 ff 00 4d chr ( M )
00 00 00 00 00 00 ff fc fc fc ff 00 00 00 ff 00 4e chr ( N )
00 00 00 00 00 00 ff fe fe fe ff 00 00 00 ff 00 4f chr ( O )
00 00 00 00 00 00 ff ff ff ff ff 00 00 00 ff 00 50 chr ( P )
00 07 04 04 04 04 04 04 04 04 04 04 07 00 ff 00 51 chr ( Q )
00 ff 01 f9 01 f9 01 f9 01 0f 0a 0c f8 00 ff 00 52 chr ( R )
00 00 00 00 08 18 38 78 38 18 08 00 00 00 ff ff 53 chr ( S )
00 00 00 0c 1e 1c 1c 0c 0e 07 03 00 00 00 ff ff 54 chr ( T )
00 00 00 00 00 00 00 00 20 f0 f0 e0 00 00 ff ff 55 chr ( U )
00 3f 7f 70 77 67 6f 6f 67 77 70 7f 3f 00 ff ff 56 chr ( left batt )
00 fc fe 06 f6 f6 f6 f6 f6 f6 06 fe fc 00 ff ff 57 chr ( right batt )
maxi here to ( allot space for the font )
( tlh 5/30:6:17 )
code cwides nx ) jsr, ;c ( ROM array )
2020202 , 2020202 , 2ff02ff , ffff0202 , ( tab/ds/pb/cr, others unused )
2020202 , 2020202 , 2020202 , 2020202 , ( 10-1f: pseudo-blanks)
2020202 , 2020202 , 2020202 , 2020202 , ( 20-2f: ascii... )
2020202 , 2020202 , 2020202 , 2020202 , ( 30-3f: ascii... )
2020202 , 2020202 , 2020202 , 2020202 , ( 40-4f: ascii... )
2020202 , 2020202 , 2020202 , 2020202 , ( 50-5f: ascii... )
2020202 , 2020202 , 2020202 , 2020202 , ( 60-6f: ascii... )
2020202 , 2020202 , 2020202 , 2020202 , ( 70-7f: ascii... )
2020202 , 2020202 , 2020202 , 2020202 , ( 80-8f: extra chrs )
2020202 , 2020202 , 2020202 , 2020202 , ( 90-9f: extra chrs )
2020202 , 2020202 , 2020202 , 2020202 , ( a0-af: extra chrs )
2020202 , 2020202 , 2020202 , 2020202 , ( b0-bf: extra chrs )
0000000 , 0000000 , 0000000 , 0000000 , ( c0-cf: accent modifiers )
2020202 , 2020202 , 2020202 , 2020202 , ( d0-df: extra chrs )
ff000000 , 0 , 0 , 0 , ( e0-ef: commands, char modifiers)
0 , 0 , 0 , 0 , ( f0-ff: encoded data )
code <#defaults> nx ) jsr, ;c ( default values for format )
esize allot ( it wants to be esize long )
tc' <#defaults> 2+ target + ( leave start of array on stack )
dup esize -1 fill
00 over %pg + !
00 over %pgl + !
text over %wr + !
00 over %ln + !
00 over %lnl + w!
00 over %spr + c!
01 over %lsp + c!
0e over %left + c!
84 over %wide + c!
0e over %indent + c!
84 over %iwide + c!
00 over %just + c!
00 over %tabs + c!
10 over %tabs 1+ + c!
02 over %tabs 2+ + c!
08 over %tabs 3 + + c!
20 over %tabs 4 + + c!
80 over %tabs 5 + + c!
00 over %tabs 6 + + c!
02 over %tabs 7 + + c!
00 over %tabs 8 + + c!
00 over %tabs 9 + + c!
00 over %tabs 0a + + c!
00 over %tabs 0b + + c!
00 over %tabs 0c + + c!
00 over %tabs 0d + + c!
00 over %tabs 0e + + c!
00 over %tabs 0f + + c!
00 over %tabs 10 + + c!
00 over %tabs 11 + + c!
00 over %tabs 12 + + c!
00 over %tabs 13 + + c!
6e over %long + w!
0c over %above + c!
0c over %below + c!
markbl over %lock + c!
01 over %ipage + w!
02 over %iprint + w!
drop
( Decision table for combining graphics elements)
code rulersmarts nx ) jsr, ;c ( decision table for ruler line display )
00 c, ( short tick )
01 c, ( long tick )
0202 w, ( normal tab )
0303 w, ( decimal tab )
0C0C w, ( two tabs: impossible )
04053E3E , 3F3F0C0C , ( Right margin + ticks & tabs )
06074040 , 41410C0C , ( Left margin + ticks & tabs)
0C0C0C0C , 0C0C0C0C , ( LM = RM is impossible )
08094242 , 43430C0C , ( Left indent + ticks & tabs )
0C0C0C0C , 0C0C0C0C , ( Left indent = RM is impossible )
0A0B4444 , 45450C0C , ( Left indent + LM + ticks & tabs)
0C0C0C0C , 0C0C0C0C , ( Indent + LM + RM is impossible )
10 c, ( generate a blank space )
code goldenbytes nx ) jsr, ;c ( pre-built pattern for status modes, etc. )
tc' goldenbytes 2+ target + goldbytes to ( goldbytes is start of array )
5100 w, 5200 w, 5300 w, ( Line # icon )
1 boldbit shl 2000 + 6 w,'s ( total of 9 words )
here goldbytes - indichars to
1 boldbit shl 2000 + 2a w,'s ( indicator area, 42 words, 51 total )
here goldbytes - modechars to
1A00 w, 1C00 w, 1E00 w, 2000 w, 2200 w, 2400 w, 2600 w, 2800 w,
0F00 w, ( paragraph style icons )
2A00 w, 2C00 w, 2E00 w, 3000 w, 3200 w, 3400 w, 0F00 w, ( spacing)
3600 w, 3800 w, 3A00 w, 3C00 w, 0F00 w, ( keyboard modes)
2000 1 boldbit shl + w, ( space before gas gauge )
( End of mode light template [22 words] 73 words total )
here goldbytes - modechars - #goldenmodes to ( length of modechars)
here goldbytes - gaugepos to ( position of the gauge in ruler )
4600 w, ( gauge left edge graphic)
4800 w, 4800 w, 4800 w, 4800 w, 4800 w, 4800 w, ( gas gauge)
4700 w, ( 'Full' mark)
1 boldbit shl 2000 + dup dup w, w, ( Expansion for gas gauge )
1 stopbit shl + w, ( stop mark )
( gas gauge, 11 words, 84 total )
here goldbytes - #goldenbytes to
( statbuff is a ram array, goldenbytess is a rom table, #goldenbytes,
#goldenmodes and modechars are ROM ints )
code <statuslights> nx ) jsr, ;c ( a table of status light positions)
tc' <statuslights> 2+ tromaddr' statuslights ! ( initialize variable )
( Format is: length in words of string, light start position [byte offset] )
indichars target - 2+ ( 8 sequential lights #0-7 )
0006 dup w, over w, 3 + lbufwide * + ( 'Phone' light )
0007 dup w, over w, 3 + lbufwide * + ( 'Learn ?' light )
0005 dup w, over w, 3 + lbufwide * + ( 'Local' light )
000a dup w, over w, 3 + lbufwide * + ( 'Thinking' light )
0002 dup w, over w, 3 + lbufwide * + ( 'Low Bat' light )
0001 dup w, over w, 3 + lbufwide * + ( 'unused' light )
0001 dup w, over w, 3 + lbufwide * + ( 'unused' light )
0001 dup w, over w, 3 + lbufwide * + ( 'unused' light )
drop ( no more, drop position )
( other non-sequential lights starting at 8 )
002c w, indichars target - 2+ w, ( make a general light off end )
code <maptable> nx ) jsr, ;c
tc' <maptable> 2+ tromaddr' maptable ! ( initialize the variable )
patternsize allot
tc' <maptable> 2+ target +
dup patternsize 0 fill ( most chars map to themselves )
93 over 20 + c! ( permanent space is uppercase spc )
41 over 61 + c! ( map lowercase to uppercase )
42 over 62 + c!
43 over 63 + c!
44 over 64 + c!
45 over 65 + c!
46 over 66 + c!
47 over 67 + c!
48 over 68 + c!
49 over 69 + c!
4A over 6A + c!
4B over 6B + c!
4C over 6C + c!
4D over 6D + c!
4E over 6E + c!
4F over 6F + c!
50 over 70 + c!
51 over 71 + c!
52 over 72 + c!
53 over 73 + c!
54 over 74 + c!
55 over 75 + c!
56 over 76 + c!
57 over 77 + c!
58 over 78 + c!
59 over 79 + c!
5A over 7A + c!
92 over 91 + c! ( ae )
8f over 86 + c! ( A circle )
83 over 84 + c! ( o slash )
88 over 89 + c! ( l doc )
80 over 87 + c! ( c cedilla )
8d over 8c + c! ( tic n )
ds swap pb + c! ( page maps to document separator )
code <cursorimage> nx ) jsr, ;c ( the data for the cursor )
tc' <cursorimage> 2+ tromaddr' cursorimage ! ( initialize variable )
tc' <cursorimage> 2+ tromaddr' wcursorimage !
tc' <cursorimage> 2+ tromaddr' ncursorimage !
aa55 scans/image 2/ w,'s ( init cursor image )
code msgtbl nx ) jsr, ;c ( defmsg table )
t' defmsg w, ( standard default )
t' eggmsg w, ( credits, where due )
t' fedmsg w, ( the parody bits )
0000 w, ( indicate end of table )
( tlh 8/12:12:40 )
code ~disp 0 #n d1 moveq,
d1 d2 move, d1 d3 move, d1 d4 move, d1 d5 move, d1 d6 move, d1 d7 move,
0 :l stopbit #n d1 btst, 3 ne .w bra,
smallbit #n d1 btst, 2 ne .w bra, 1 :l
begin, 0 #n d0 moveq, a1 a0 move, a3 )+ d0 .b move, 4 #n d0 .w lsl,
d0 a0 add, a3 )+ d1 .b move, ne
lif, boldbit #n d1 btst, ne if, a4 a0 add, then,
invbit #n d1 btst, ne
lif, a0 )+ d0 .b move, d0 .b not, d0 a2 )+ .b move,
a0 )+ d2 .b move, d2 .b not, a0 )+ d3 .b move, d3 .b not,
a0 )+ d4 .b move, d4 .b not, 5 #n d1 btst, ne
if, d0 d3 .b move, d0 d4 .b move, then,
d2 a2 /scan 1- )d .b move, d3 a2 /scan 2 * 1- )d .b move,
d4 a2 /scan 3 * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 4 * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 5 * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 6 * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 7 * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 8 * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 9 * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 0a * 1- )d .b move,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 0b * 1- )d .b move,
a0 )+ d0 .b move, ulinebit #n d1 btst, ne if, a0 1 )d d0 .b move, then,
d0 .b not, d0 a2 /scan 0c * 1- )d .b move,
a0 )+ d0 .b move, dlinebit #n d1 btst, ne if, 99 #n d0 .b move, then,
d0 .b not, d0 a2 /scan 0d * 1- )d .b move,
a3 )+ d0 .w move, 0 eq .w bra,
c0 #n d0 .b cmpi, nc
if, 0 #n a0 1 )d .b btst, ne if, 10 #n d0 .b sub, then, then, a1 a0 move,
4 #n d0 .w lsl, d0 a0 add, boldbit #n d1 btst, ne if, a4 a0 add, then,
a0 )+ d0 .b move, d0 .b not, d0 a2 -1 )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 2 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 3 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 4 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 5 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 6 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 7 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 8 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 9 * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 0a * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 0b * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 0c * 1- )d .b or,
a0 )+ d0 .b move, d0 .b not, d0 a2 /scan 0d * 1- )d .b or, 0 .w bra,
then, a0 )+ a2 )+ .b move, a0 )+ a2 /scan 1- )d .b move,
a0 )+ a2 /scan 2* 1- )d .b move, a0 )+ a2 /scan 3 * 1- )d .b move,
a0 )+ a2 /scan 4 * 1- )d .b move, a0 )+ a2 /scan 5 * 1- )d .b move,
5 #n d1 btst, ne if, a2 -1 )d a2 /scan 2* 1- )d .b move,
a2 -1 )d a2 /scan 3 * 1- )d .b move, then,
a0 )+ a2 /scan 6 * 1- )d .b move, a0 )+ a2 /scan 7 * 1- )d .b move,
a0 )+ a2 /scan 8 * 1- )d .b move, a0 )+ a2 /scan 9 * 1- )d .b move,
a0 )+ a2 /scan 0a * 1- )d .b move, a0 )+ a2 /scan 0b * 1- )d .b move,
a0 )+ d0 .b move, ulinebit #n d1 btst, ne if, a0 1 )d d0 .b move, then,
d0 a2 /scan 0c * 1- )d .b move, a0 )+ d0 .b move, dlinebit #n d1 btst, ne
if, 99 #n d0 .b move, then, d0 a2 /scan 0d * 1- )d .b move,
a3 )+ d0 .w move, 0 eq .w bra, c0 #n d0 .b cmpi, nc
if, 0 #n a0 1 )d .b btst, ne if, 10 #n d0 .b sub, then, then, a1 a0 move,
4 #n d0 .w lsl, d0 a0 add, boldbit #n d1 btst, ne if, a4 a0 add, then,
a0 )+ d0 .b move, d0 a2 -1 )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 2* 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 3 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 4 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 5 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 6 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 7 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 8 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 9 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0a * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0b * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0c * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0d * 1- )d .b and,
0 .w bra,
then,
a0 )+ a2 )+ .b move, a0 )+ a2 /scan 1- )d .b move,
a0 )+ a2 /scan 2* 1- )d .b move, a0 )+ a2 /scan 3 * 1- )d .b move,
a0 )+ a2 /scan 4 * 1- )d .b move, a0 )+ a2 /scan 5 * 1- )d .b move,
a0 )+ a2 /scan 6 * 1- )d .b move, a0 )+ a2 /scan 7 * 1- )d .b move,
a0 )+ a2 /scan 8 * 1- )d .b move, a0 )+ a2 /scan 9 * 1- )d .b move,
a0 )+ a2 /scan 0a * 1- )d .b move, a0 )+ a2 /scan 0b * 1- )d .b move,
a0 )+ a2 /scan 0c * 1- )d .b move, a0 )+ a2 /scan 0d * 1- )d .b move,
a3 )+ d0 .w move, ne
until,
c0 #n d0 .b cmp, nc
if, 0 #n a0 1 )d .b btst, ne if, 10 #n d0 .b sub, then, then, a1 a0 move,
4 #n d0 .w lsl, d0 a0 add, boldbit #n d1 btst, ne if, a4 a0 add, then,
a0 )+ d0 .b move, d0 a2 -1 )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 2 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 3 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 4 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 5 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 6 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 7 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 8 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 9 * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0a * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0b * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0c * 1- )d .b and,
a0 )+ d0 .b move, d0 a2 /scan 0d * 1- )d .b and, 1 .w bra,
2 :l ( set up for half-offset character loop )
0f #n d0 moveq, d0 a2 -1 )d .b or, d0 a2 /scan 1- )d .b or,
d0 a2 /scan 2 * 1- )d .b or, d0 a2 /scan 3 * 1- )d .b or,
d0 a2 /scan 4 * 1- )d .b or, d0 a2 /scan 5 * 1- )d .b or,
d0 a2 /scan 6 * 1- )d .b or, d0 a2 /scan 7 * 1- )d .b or,
d0 a2 /scan 8 * 1- )d .b or, d0 a2 /scan 9 * 1- )d .b or,
d0 a2 /scan 0a * 1- )d .b or, d0 a2 /scan 0b * 1- )d .b or,
d0 a2 /scan 0c * 1- )d .b or, d0 a2 /scan 0d * 1- )d .b or,
begin, 0 #n d0 moveq, a1 a0 move, a3 )+ d0 .b move, 4 #n d0 .w lsl,
d0 a0 add, a3 )+ d1 .b move, boldbit #n d1 btst, ne if, a4 a0 add, then,
-1 #n d0 moveq, d0 d2 move, d0 d3 move, d0 d4 move, d0 d5 move,
d0 d6 move, d0 d7 move,
a0 )+ d0 .b move, a0 )+ d2 .b move, a0 )+ d3 .b move,
a0 )+ d4 .b move, a0 )+ d5 .b move, a0 )+ d6 .b move, a0 )+ d7 .b move,
5 #n d1 btst, ne if, d0 d3 move, d0 d4 move, then, ( dotless i/j )
invbit #n d1 btst, ne
if, d0 .b not, d2 .b not, d3 .b not, d4 .b not, d5 .b not, d6 .b not,
d7 .b not,
then,
4 #n d0 .w ror, 4 #n d2 .w ror, 4 #n d3 .w ror,
4 #n d4 .w ror, 4 #n d5 .w ror, 4 #n d6 .w ror, 4 #n d7 .w ror,
d0 a2 -1 )d .b and, d2 a2 /scan 1- )d .b and, d3 a2 /scan 2 * 1- )d .b and,
d4 a2 /scan 3 * 1- )d .b and, d5 a2 /scan 4 * 1- )d .b and,
d6 a2 /scan 5 * 1- )d .b and, d7 a2 /scan 6 * 1- )d .b and,
8 #n d0 .w lsr, 8 #n d2 .w lsr, 8 #n d3 .w lsr, 8 #n d4 .w lsr,
8 #n d5 .w lsr, 8 #n d6 .w lsr, 8 #n d7 .w lsr,
d0 a2 ) .b move, d2 a2 /scan )d .b move, d3 a2 /scan 2 * )d .b move,
d4 a2 /scan 3 * )d .b move, d5 a2 /scan 4 * )d .b move,
d6 a2 /scan 5 * )d .b move, d7 a2 /scan 6 * )d .b move,
-1 #n d0 moveq, d0 d2 move, d0 d3 move, d0 d4 move, d0 d5 move,
d0 d6 move, d0 d7 move,
a0 )+ d0 .b move, a0 )+ d2 .b move, a0 )+ d3 .b move, a0 )+ d4 .b move,
a0 )+ d5 .b move, a0 )+ d6 .b move, a0 )+ d7 .b move,
ulinebit #n d1 btst, ne if, a0 ) d6 .b move, then,
dlinebit #n d1 btst, ne if, 99 #n d7 .b move, then,
invbit #n d1 btst, ne
if, d0 .b not, d2 .b not, d3 .b not, d4 .b not, d5 .b not, d6 .b not,
d7 .b not,
then, 4 #n d0 .w ror, 4 #n d2 .w ror, 4 #n d3 .w ror, 4 #n d4 .w ror,
4 #n d5 .w ror, 4 #n d6 .w ror, 4 #n d7 .w ror,
d0 a2 /scan 7 * 1- )d .b and, d2 a2 /scan 8 * 1- )d .b and,
d3 a2 /scan 9 * 1- )d .b and, d4 a2 /scan 0a * 1- )d .b and,
d5 a2 /scan 0b * 1- )d .b and, d6 a2 /scan 0c * 1- )d .b and,
d7 a2 /scan 0d * 1- )d .b and, 8 #n d0 .w lsr, 8 #n d2 .w lsr,
8 #n d3 .w lsr, 8 #n d4 .w lsr, 8 #n d5 .w lsr, 8 #n d6 .w lsr,
8 #n d7 .w lsr,
d0 a2 /scan 7 * )d .b move, d2 a2 /scan 8 * )d .b move,
d3 a2 /scan 9 * )d .b move, d4 a2 /scan 0a * )d .b move,
d5 a2 /scan 0b * )d .b move, d6 a2 /scan 0c * )d .b move,
d7 a2 /scan 0d * )d .b move, 0 #n d0 moveq,
a3 )+ d0 .w move, ne
lif, c0 #n d0 .b cmp, nc
if, 0 #n a0 1 )d .b btst, ne if, 10 #n d0 .b sub, then, then, a1 a0 move,
4 #n d0 .w lsl, d0 a0 add, boldbit #n d1 btst, ne if, a4 a0 add, then,
-1 #n d0 moveq, invbit #n d1 btst, ne if, 0 #n d0 moveq, then,
d0 d2 move, d0 d3 move, d0 d4 move, d0 d5 move,
d0 d6 move, d0 d7 move,
a0 )+ d0 .b move, a0 )+ d2 .b move, a0 )+ d3 .b move, a0 )+ d4 .b move,
a0 )+ d5 .b move, a0 )+ d6 .b move, a0 )+ d7 .b move,
invbit #n d1 btst, ne
if, d0 .b not, d2 .b not, d3 .b not, d4 .b not, d5 .b not, d6 .b not,
d7 .b not, 4 #n d0 .w ror, 4 #n d2 .w ror, 4 #n d3 .w ror,
4 #n d4 .w ror, 4 #n d5 .w ror, 4 #n d6 .w ror, 4 #n d7 .w ror,
d0 a2 -1 )d .b or, d2 a2 /scan 1- )d .b or,
d3 a2 /scan 2 * 1- )d .b or, d4 a2 /scan 3 * 1- )d .b or,
d5 a2 /scan 4 * 1- )d .b or, d6 a2 /scan 5 * 1- )d .b or,
d7 a2 /scan 6 * 1- )d .b or,
else, 4 #n d0 .w ror, 4 #n d2 .w ror, 4 #n d3 .w ror, 4 #n d4 .w ror,
4 #n d5 .w ror, 4 #n d6 .w ror, 4 #n d7 .w ror,
d0 a2 -1 )d .b and, d2 a2 /scan 1- )d .b and,
d3 a2 /scan 2 * 1- )d .b and, d4 a2 /scan 3 * 1- )d .b and,
d5 a2 /scan 4 * 1- )d .b and, d6 a2 /scan 5 * 1- )d .b and,
d7 a2 /scan 6 * 1- )d .b and,
then,
8 #n d0 .w lsr, 8 #n d2 .w lsr, 8 #n d3 .w lsr, 8 #n d4 .w lsr,
8 #n d5 .w lsr, 8 #n d6 .w lsr, 8 #n d7 .w lsr,
invbit #n d1 btst, ne
if, d0 a2 ) .b or, d2 a2 /scan )d .b or, d3 a2 /scan 2* )d .b or,
d4 a2 /scan 3 * )d .b or, d5 a2 /scan 4 * )d .b or,
d6 a2 /scan 5 * )d .b or, d7 a2 /scan 6 * )d .b or,
else, d0 a2 ) .b and, d2 a2 /scan )d .b and, d3 a2 /scan 2* )d .b and,
d4 a2 /scan 3 * )d .b and, d5 a2 /scan 4 * )d .b and,
d6 a2 /scan 5 * )d .b and, d7 a2 /scan 6 * )d .b and,
then,
-1 #n d0 moveq, invbit #n d1 btst, ne if, 0 #n d0 moveq, then,
d0 d2 move, d0 d3 move, d0 d4 move, d0 d5 move,
d0 d6 move, d0 d7 move,
a0 )+ d0 .b move, a0 )+ d2 .b move, a0 )+ d3 .b move, a0 )+ d4 .b move,
a0 )+ d5 .b move, a0 )+ d6 .b move, a0 )+ d7 .b move,
invbit #n d1 btst, ne
if, d0 .b not, d2 .b not, d3 .b not, d4 .b not, d5 .b not, d6 .b not,
d7 .b not, 4 #n d0 .w ror, 4 #n d2 .w ror, 4 #n d3 .w ror,
4 #n d4 .w ror, 4 #n d5 .w ror, 4 #n d6 .w ror, 4 #n d7 .w ror,
d0 a2 /scan 7 * 1- )d .b or, d2 a2 /scan 8 * 1- )d .b or,
d3 a2 /scan 9 * 1- )d .b or, d4 a2 /scan 0a * 1- )d .b or,
d5 a2 /scan 0b * 1- )d .b or, d6 a2 /scan 0c * 1- )d .b or,
d7 a2 /scan 0d * 1- )d .b or,
else, 4 #n d0 .w ror, 4 #n d2 .w ror, 4 #n d3 .w ror, 4 #n d4 .w ror,
4 #n d5 .w ror, 4 #n d6 .w ror, 4 #n d7 .w ror,
d0 a2 /scan 7 * 1- )d .b and, d2 a2 /scan 8 * 1- )d .b and,
d3 a2 /scan 9 * 1- )d .b and, d4 a2 /scan 0a * 1- )d .b and,
d5 a2 /scan 0b * 1- )d .b and, d6 a2 /scan 0c * 1- )d .b and,
d7 a2 /scan 0d * 1- )d .b and,
then,
8 #n d0 .w lsr, 8 #n d2 .w lsr, 8 #n d3 .w lsr, 8 #n d4 .w lsr,
8 #n d5 .w lsr, 8 #n d6 .w lsr, 8 #n d7 .w lsr,
invbit #n d1 btst, ne
if, d0 a2 /scan 7 * )d .b or, d2 a2 /scan 8 * )d .b or,
d3 a2 /scan 9 * )d .b or, d4 a2 /scan 0a * )d .b or,
d5 a2 /scan 0b * )d .b or, d6 a2 /scan 0c * )d .b or,
d7 a2 /scan 0d * )d .b or,
else, d0 a2 /scan 7 * )d .b and, d2 a2 /scan 8 * )d .b and,
d3 a2 /scan 9 * )d .b and, d4 a2 /scan 0a * )d .b and,
d5 a2 /scan 0b * )d .b and, d6 a2 /scan 0c * )d .b and,
d7 a2 /scan 0d * )d .b and,
then,
then, 1 #n a2 addq, smallbit #n d1 btst, ne
until, 1 #n a2 subq,
stopbit #n d1 btst, 1 eq .w bra, 3 :l rts, ;c
( n --- ,blank half-line at position n on screen ) ( tlh 3/07:20:12 )
code halfdisp sp )+ d0 move, /scan tophalf * #n d0 .w mulu,
screenstart #n d0 add, d0 a0 move, tophalf 1- #n d0 moveq,
-1 #n d1 moveq, -1 #n d2 moveq,
lok #n #lock .b cmpi, eq if, 55 #n d2 moveq, then,
begin, /lscan 4 / 2- #n d3 moveq,
1 #n d2 .b rol, d2 a0 )+ .b move,
d1 a0 )+ .b move,
begin, d1 a0 )+ move, d3 nt -until,
d1 a0 )+ .b move,
d2 a0 )+ .b move,
/scan /lscan - #n a0 add,
d0 nt -until, next;
( tlh 5/7:7:24 )
code disp sp )+ d0 move, ( half-line position ) /scan 7 * #n d0 .w mulu,
screenstart #n d0 add,
(regs d4 d5 d6 d7 a2 a3 a4 to) sp -) movem, lbuff #n a3 move, d0 a2 move,
bp bp .b sub, bp a0 move, a0 a0 .w add, a0 a0 .w add,
a0 t' romanfont 4 * )d a1 move, a0 t' boldfont 4 * )d a4 move, a1 a4 sub,
2 #n a1 addq,
tc' ~disp jsr,
(regs d4 d5 d6 d7 a2 a3 a4 from) sp )+ movem, next;
( Cat ruler 19Jun87/dab)
code ~showrule ( display the pre-built ruler line )
( Register usage: d0-d3 various stuff
a0-a1 work pointers, a1 usually display ram
a2 points to rulerfont
a3 points to rulersmarts
a4 points at display ram [rulerstart]
a5 points at rulerbuff )
0 #n bp .b move,
bp a0 move, a0 a0 .w add, a0 a0 .w add,
a0 t' rulerfont 4 * )d a2 move,
2 #n a2 addq, ( a2: font pointer )
tc' rulersmarts 2+ #n a3 move, ( a3: decision table)
( Open Question: should rulersmarts be located at run time?)
i' trkbuf a4 move, a4 a5 move,
480 #n a4 add, ( a4: back buffer )
400 #n a5 add, ( a5: ruler buffer )
0 #n d0 moveq, ( d0: main work reg)
/scan 1- #n d1 moveq, ( d1: loop count)
-1 #n d2 moveq, ( d2: blank space)
a4 a1 move, ( a1: display RAM )
begin, ( display the ruler line )
a5 )+ d0 .b move, ( get next ruler byte)
a3 d0 0 xw)d d0 .b move, ( translate to ruler char)
d0 d3 .w move, ( d3: 00nn character number)
4 #n d3 .w lsl, ( d3: rulerfont index )
a2 d3 0 xw)d a0 lea, ( a0: character address)
a0 )+ d0 .b move,
a0 )+ a1 /scan 1 * )d .b move, ( move image bytes over...)
a0 )+ a1 /scan 2 * )d .b move, ( ...to the screen)
a0 )+ a1 /scan 3 * )d .b move,
a0 )+ a1 /scan 4 * )d .b move,
a0 )+ a1 /scan 5 * )d .b move,
a0 )+ a1 /scan 6 * )d .b move,
a0 )+ a1 /scan 7 * )d .b move,
a0 )+ a1 /scan 8 * )d .b move,
a0 )+ a1 /scan 9 * )d .b move,
a0 )+ a1 /scan 0A * )d .b move,
a0 )+ a1 /scan 0B * )d .b move,
a0 )+ a1 /scan 0C * )d .b move,
a0 )+ a1 /scan 0D * )d .b move,
d2 a1 /scan 0E * )d .b move, ( blank gap below ruler)
d2 a1 /scan 0F * )d .b move,
d2 a1 /scan 10 * )d .b move,
d0 a1 )+ .b move,
d1 nt -until,
d0 d1 move, d0 d2 move, ( clear high bits )
#indent d0 .b move, 1 #n d0 .w lsr, ( d0: indent)
#iwide d1 .b move, 1 #n d1 .w lsr, ( d1: RM - indent)
#left d2 .b move, 1 #n d2 .w lsr, ( d2: left margin)
a4 d0 ruleredge xw)d a1 lea, ( a1: starting address of rule)
0 #n d3 moveq, ( d3: some black bits )
0 bra,
begin, ( render the indent -> RM rule )
d3 a1 )+ .b move,
0 :l d1 nt -until,
a4 0f /scan * ruleredge + )d a1 lea,
d2 a1 add, ( a1: start of bottom rule)
0 #n d1 moveq, #wide d1 .b move, 1 #n d1 .w lsr, ( d1: length)
7F #n a1 /scan negate )d .b move, ( hack left corner of the ruler box )
1 bra,
begin, d3 a1 )+ .b move, 1 :l d1 nt -until, ( make left-right line)
FE #n a1 /scan 1+ negate )d .b move, ( hack right corner of ruler box )
d0 d2 .w cmp, lt if, d0 d2 exg, then, ( d0: min[indent,LM] )
a4 7 /scan * ruleredge + )d a1 lea,
( a1: left edge, line 8 of ruler )
d0 a1 add, d0 d2 sub, ( d2: byte count )
2 bra, ( clever loop entry)
begin, ( render the LM -> indent rule )
d3 a1 )+ .b move, 2 :l
d2 nt -until,
( Now we add the ruler numbering )
110 #n a2 add, ( a2: first legend char image)
a4 0b )d a1 lea, ( a1: display address )
/scan 0c - #n d1 .w move, ( d1: loop counter )
begin,
a2 )+ d0 .b move, d0 a1 ) .b and,
a2 )+ d0 .b move, d0 a1 /scan 1 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 2 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 3 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 4 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 5 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 6 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 7 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 8 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 9 * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 0A * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 0B * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 0C * )d .b and,
a2 )+ d0 .b move, d0 a1 /scan 0D * )d .b and,
2 #n a2 addq, ( a2: next char image [skip uline bytes])
0a #n a1 addq, ( a4: next display position)
0a #n d1 sub, ( d1: new length count)
lt until, ( loop until right edge is hit )
rts, ( End of ruler display routine )
;c
code ~showstatus ( -- \ update statbuff, and disp the status line )
( trashes all registers in the known universe... )
#goldenmodes 2 / 1- #n d0 moveq, ( d0: loop counter)
goldbytes modechars + target - #n a0 move, ( a0: golden pointer )
statbuff modechars 2* + #n a1 move, ( a1: status buffer )
0 #n d1 moveq, ( d1: a zero for overstrike)
begin, a0 )+ a1 )+ .w move, ( copy golden data to buffer)
d1 a1 )+ .w move, ( add a zero for overstrike bytes)
d0 nt -until,
statbuff modechars 2* + #n a1 move, 01 #n d1 moveq, 0 #n d0 moveq,
i' typermode tst, eq
if, #just d0 .b move, eq ( test the paragraph style)
if, d1 a1 ) .b or, d1 a1 4 )d .b or, ( set 'left' icon) then,
1 #n d0 subq, eq if, d1 a1 10 )d .b or, d1 a1 14 )d .b or, then, ( right )
1 #n d0 subq, eq if, d1 a1 08 )d .b or, d1 a1 0c )d .b or, then, ( cntr )
1 #n d0 subq, eq if, d1 a1 18 )d .b or, d1 a1 1c )d .b or, then, ( both )
else, 20020000 #n d1 move, d1 a1 04 )d move, d1 a1 08 )d move,
d1 a1 0c )d move, d1 a1 10 )d move, d1 a1 14 )d move, d1 a1 18 )d move,
d1 a1 1c )d move, d1 a1 ) move, d1 statbuff move, d1 statbuff 4 + move,
d1 statbuff 8 + move, d1 statbuff 0c + move, d1 statbuff 10 + move,
d1 a1 58 )d move, d1 a1 5c )d move, d1 a1 60 )d move, d1 a1 64 )d move,
d1 a1 68 )d move, d1 a1 6c )d move, d1 a1 70 )d move, d1 a1 74 )d move,
d1 a1 78 )d move, d1 a1 7c )d move, d1 a1 80 )d move,
10 #n a1 81 )d .b or, 1 #n d1 moveq,
then,
#lsp d0 .b move, ( test line spacing mode)
1 #n d0 .b cmpi,
eq if, d1 a1 24 )d .b or, d1 a1 28 )d .b or, ( set 'single space')
else, 2 #n d0 .b cmpi,
eq if, d1 a1 2c )d .b or, d1 a1 30 )d .b or, ( set '1 1/2' spacing)
else, 3 #n d0 .b cmpi,
eq if, d1 a1 34 )d .b or, d1 a1 38 )d .b or, ( set 'double space' )
then, then, then,
i' system.status a2 move, a2 kbdI/II )d .b tst, ne
if, ( base of non-saved area )
0 #n a2 modifiers 3 + )d .b btst, ( see which kbd is active )
eq if, d1 a1 40 )d .b or, d1 a1 44 )d .b or, ( set 'keyboard I' )
else, d1 a1 48 )d .b or, d1 a1 4c )d .b or, then, ( set 'keyboard II' )
else, 20020000 #n d1 move, d1 a1 40 )d move, d1 a1 44 )d move,
d1 a1 48 )d move, d1 a1 4c )d move, 1 #n d1 moveq,
then,
( Now decide if we should display black-on-white or white-on-black )
9 bsr,
( The rest of the display line is 'built' as status changes are posted. All we
have to do here is call ~disp to put up the graphics )
i' trkbuf a2 move, scans/image 3 + /scan * 480 + #n a2 add,
( a2: back buffer addr of stat line)
statbuff #n a3 move, ( a3: status 'build' buffer )
bp bp .b sub, bp a0 move, a0 a0 .w add, a0 a0 .w add,
a0 t' rulerfont 4 * )d a1 move, a0 t' boldfont 4 * )d a4 move, a1 a4 sub,
2 #n a1 addq,
tc' ~disp jsr, ( go disp it!)
( now flip things back)
9 bsr,
( special 'don't crush that scan line! hand me the pliers!' loop, )
( blanks out the top line of the status line.)
( Don't ask why, you don't want to know)
i' trkbuf a4 move, scans/image 3 + /scan * 480 + #n a4 add,
( a4: screen ram addr of stat line )
/scan 4 / 1- #n d0 move, ( d0: longs to zap )
i' ruleblink d1 move, d1 not, ( d1: color of the bits )
begin, d1 a4 )+ move, d0 nt -until,
rts, ( end of ~showstatus )
9 :l ( if ruleblink is on, invert the status line )
i' ruleblink tst,
ne if, ( do we have to flip? )
statbuff #n a0 move, ( yes, toggle all invbits )
begin, a0 ) d0 move, invbit 10 + #n d0 bchg,
d0 a0 )+ move, stopbit 10 + #n d0 btst,
ne until, then, rts,
;c
code >lbuff ( source dest count -- \ move 'count' words from 'source',)
( appending a word of zeros at 'dest' for new lbuff format )
sp )+ d0 move, sp )+ a1 move, sp )+ a0 move,
0 #n d1 moveq, 0 bra, ( clever loop entry )
begin, a0 )+ a1 )+ .w move, d1 a1 )+ .w move,
0 :l d0 nt -until, next;
: initruler ( -- \ set up the empty status line )
blackscreen if blackruler off else blackruler on then
ruleblink off
ramend ramstart - 40000 > if 48 else 30 then gaugesize to
oldgauge on oldlnl on ( force rethinking )
[ goldbytes target - ] literal
[ statbuff ] literal
[ #goldenbytes 2/ ] literal >lbuff ;
code rule ( -- \ rethink, then redisplay the ruler )
( Register usage: a0-a2/d0-d3
but remember that ~showrule uses d0-d2,a0-a5
and ~showstatus uses d0-d7/a0-a6 )
(regs d4 d5 d6 d7 a2 a3 a4 a5 a6 to) sp -) movem, ( scram!)
i' trkbuf a2 move, 400 #n a2 add, ( a2: ruler buffer )
a2 a0 move, ( a0: scans rulerbuff)
a2 a1 move, /scan #n a1 .w add, ( a1: end of rulerbuff)
0b #n d2 moveq, ( d2: first long tick posn)
8 #n d3 moveq, ( d3: chars between ticks-1)
0 #n d0 moveq, d0 d1 move,
0 bra, ( enter the loop testing first)
begin,
begin, d0 a0 )+ .b move, 0 :l d2 nt -until,
01 #n a0 )+ .b move, ( add a tick mark )
d3 d2 move, ( reset inner counter)
a1 a0 cmp,
ge until, ( until we hit the right edge)
#left d0 .b move, 1 #n d0 .w lsr, ( d0: Left margin position)
4 #n a2 d0 ruleredge xw)d .b bset, ( set the LM bit)
#wide d1 .b move, 1 #n d1 .w lsr,
d0 d1 add, ( d1: Right margin position)
3 #n a2 d1 ruleredge 1- xw)d .b bset, ( set the RM bit)
#indent d0 .b move, 1 #n d0 .w lsr, ( d0: Indent position)
5 #n a2 d0 ruleredge xw)d .b bset, ( set indent bit)
#tabs #n a1 move, ( a1: tab table )
0 #n d0 moveq, 0 #n d1 moveq, 0 #n d2 moveq, 0 #n d3 moveq,
begin, a1 0a )d d3 .b move, ( 8 bits of decimal tab marks )
a1 )+ d2 .b move, ( 8 bits of tab marks ) ne
if, begin, d1 d2 btst, ne
if, d1 d3 btst, ne
if, 2 #n a2 d0 ruleredge xw)d .b bset,
else, 1 #n a2 d0 ruleredge xw)d .b bset,
then,
then, 1 #n d0 .w addq, 1 #n d1 .w addq, 7 #n d1 .w and, eq
until, ( finished with 8 potential tab stops )
else, 8 #n d0 .w addq,
then, #tabs 0a + #n a1 cmp, nc
until,
4040 #n a2 /scan 2 - )d .w move, ( last char is blank )
4040 #n a2 ) .w move, ( start with 2 blanks )
tc' ~showrule jsr, ( go display ruler line)
tc' ~showstatus jsr, ( display the status line)
( Now that we have done all the rendering, copy the result to the screen )
i' trkbuf a4 move, 480 #n a4 add,
( a4: screen ram addr of stat line )
screenstart /scan 2* - #n a1 move, ( a1: REAL top of screen )
/scan 2/ 1- #n d0 moveq, ( d0: 2 scan lines )
( chose black top and bottom margins in typewriter mode, else white )
i' typermode tst, eq if, -1 #n d1 moveq, else, 0 #n d1 moveq, then,
begin, d1 a1 )+ move, d0 nt -until, ( clear it out )
rulerstart /scan * screenstart + #n a1 move, ( a1: display RAM)
/scan 4 / 1- #n d0 moveq, ( d0: 1 line worth of white)
begin, d1 a1 )+ move, d0 nt -until,
i' blackruler d1 move, d1 not, ( switch to ruler color)
/scan 3 * 4 / 1 - #n d0 moveq, ( 2 lines worth )
begin, d1 a1 )+ move, d0 nt -until,
1e /scan * 4 / 1- #n d2 .w move, ( scanlines to copy over)
d1 tst, eq if, ( need to invert image? )
begin, a4 )+ d0 move, d0 not, d0 a1 )+ move, d2 nt -until,
else,
begin, a4 )+ a1 )+ move, d2 nt -until,
then,
(regs d4 d5 d6 d7 a2 a3 a4 a5 a6 from) sp )+ movem,
next;
code indicate ( addr # light# -- \ set value of light# to string )
( no longer centers the string, statuslight takes string up to limit)
sp )+ d0 move, 2 #n d0 asl, i' statuslights a1 move,
0 #n d2 moveq,
a1 d0 0 xw)d d2 .w move, a1 d0 2 xw)d a1 .w move,
statbuff #n a1 add, ( a1,d2: addr,len in statbuff)
sp )+ d1 move, sp )+ a0 move, ( a0,d1: new string)
ne lif, ( string is not zero length)
0D000000 #n a1 )+ move, ( put down left edge char)
1 invbit shl 1 boldbit shl + #n d0 moveq,
0 #n d3 moveq, ( overstrike & attribute bytes )
1 bra, ( enter main building loop)
begin, ( copy string to statbuff)
a0 )+ a1 )+ .b move, ( copy a text byte)
d0 a1 )+ .b move, ( append an attribute byte)
d3 a1 )+ .w move, ( and two overstrike bytes )
1 :l 1 #n d1 subq, d2 lt -until, ( until either counter expires)
0E000000 #n a1 )+ move, ( right edge of light)
0 #n d2 .w cmpi, ( stuff left to blank out? )
pl if, ( room left)
2000 1 boldbit shl + 10 shl #n d0 move,
2 bra, ( erase any garbage left in the rest of the light)
begin, d0 a1 )+ move, 2 :l d2 nt -until,
then,
next, ( we're done with the non-null case, exit)
then, ( when string length is zero)
1 #n d2 addq, ( loop d2+2 times)
2000 1 boldbit shl + 10 shl #n d0 move,
( d0: a white space )
begin, d0 a1 )+ move, d2 nt -until, ( blank the light)
next; ( all done updating statbuff)
code >status ( addr # offset flags -- \ put string into statbuff )
sp )+ d0 move,
sp )+ a0 move, a0 a0 add, a0 a0 add, statbuff #n a0 add,
sp )+ d1 move,
sp )+ a1 move,
0 bra,
begin, d0 a0 )+ move, a1 )+ a0 -4 )d .b move,
0 :l d1 nt -until, next;
( additional ruler stuff )
: bl# ( num -- num' \ convert output digit, or a blank )
dup if # else spc hold then ;
: checkbattery ( -- \ every few years, whine about the dead SV battery )
[ ga3 pr.cont + ] literal c@ 80 and ( is it dead yet? )
if <"> [ 2 c, 56 c, 57 c, ] ( well, at least coughing up blood... )
else <"> [ 2 c, 0f c, 0f c, ] then
<statuslights> 12 + w@ 2 shr 0 >status ;
: checkline# ( -- \ update line# in statbuff )
#lnl w@ oldlnl <>
if ( we have something to do)
base decimal ( no hex display for the Mundanes)
#lnl w@ 2/ 1+ <# # bl# #>
line#pos [ 1 boldbit shl 10 shl ] literal >status
#lnl w@ oldlnl to
base to ( back to the old radix)
then ;
code newgauge? ( -- f \ true if gas gauge has changed state)
( 25apr87/dab -- now reflects total RAM size )
i' beot d0 move, i' gap d0 sub,
i' applic d0 add, i' here d0 sub, ( free space )
d0 tst,
0 mi bra, ( skip if pointers are hosed)
i' endtext d1 move, i' endtable d1 sub, ( avail space)
8 #n d0 lsr, 8 #n d1 lsr, ( scale to a word range )
i' gaugesize d2 move, ( pixel size of the gas gauge)
d2 d0 .w mulu, d1 d0 .w divu,
d2 d1 move, d0 d1 .w sub, ( d0: new gauge)
lt if, ( invalid value) 0 :l d2 d1 move, then,
i' oldgauge d1 cmp, ( did it change since last time?)
eq if, 0 #n d0 moveq,
else, -1 #n d0 moveq, d1 i' oldgauge move, then,
d0 sp -) move, next;
: checkgauge ( -- \ redraw gas gauge as necessary)
( 25apr87/dab -- now gauge changes size with memory size )
( Note: This word 'knows' where some chars in the rulerfont are located!)
newgauge? if ( need a new gas display )
<# 47 hold ( Full mark )
gaugesize oldgauge - 8 / ( blank space)
dup 0 > if 0 do 48 hold loop else drop then
oldgauge 8 mod ( partial char worth )
dup 1 7 inrange if 48 + hold else drop then
oldgauge 8 / ( all-white part)
dup 0 > if 0 do 50 hold loop else drop then
46 hold ( Empty mark )
0 #>
[ gaugepos 2/ ] literal 0 >status
[ statbuff /scan lbufwide * + 3 - ] literal dup c@
[ 1 stopbit shl ] literal or swap c!
( Don't crush that stopbit, hand me the pliers! )
then ;
code ^sk>
d0 sp -) move, a0 )+ d0 .b move, d0 .w ext, 8 #n d0 lsl, a0 )+ d0 .b move,
8 #n d0 lsl, a0 )+ d0 .b move, d0 a0 add, sp )+ d0 move, rts, ;c
code ^sk<
d0 sp -) move, a0 -3 )d d0 .b move, d0 .w ext, 8 #n d0 lsl,
a0 -2 )d d0 .b move, 8 #n d0 lsl, a0 -1 )d d0 .b move, d0 a0 sub,
sp )+ d0 move, rts, ;c
( load format control packet with address in a0 ) ( 7/2:15:22 )
code ^fmt> &skip #n d0 .b cmp, eq
if, d0 sp -) move, a0 )+ d0 .b move, d0 .w ext, 8 #n d0 lsl,
a0 )+ d0 .b move, 8 #n d0 lsl, a0 )+ d0 .b move, d0 a0 add,
sp )+ d0 move, rts,
then, &fmt #n d0 .b cmp, eq
if, a1 sp -) move, #ctrl %lsp + #n a1 move,
d1 sp -) move, %long %lsp - 1- #n d1 moveq, d0 sp -) move,
a0 )+ d0 .b move, 4 #n d0 .b rol, a0 )+ d0 .b and, d0 a1 )+ .b move,
2 #n a0 addq, ( skip second byte in packet as meaningless -- see makepkt )
begin, a0 )+ d0 .b move, 4 #n d0 .b rol,
a0 )+ d0 .b and, d0 a1 )+ .b move,
14 #n d1 .b cmp, eq if, 1 #n a1 subq, then, d1 nt
-until, sp )+ d0 move, #lsp #spr .b move,
sp )+ d1 move, sp )+ a1 move, rts,
then, &firstcmd #n d0 .b cmp, nc
if, begin, &lastcmd #n a0 )+ .b cmpi, cs until, 1 #n a0 subq, then,
rts, ;c
( addr --- ,create packet at addr from control formats )
( tlh 7/2:15:55 )
code makepkt
#lsp #n a0 move, sp )+ a1 move, ( a0=src, a1=dest )
#long #lsp - 2- #n d0 moveq, &fmt #n a1 )+ .b move, ( leader byte in text)
f0 100 - #n d3 moveq, ( 'f0' is upper part of all following bytes )
a0 )+ d1 .b move, d1 d2 .b move, 4 #n d1 .b lsr, d3 d1 .b or,
d1 a1 )+ .b move, d3 d2 .b or, d2 a1 )+ .b move,
d2 a1 )+ .b move, d2 a1 )+ .b move,
begin, a0 )+ d1 .b move, d1 d2 .b move, 4 #n d1 .b lsr, d3 d1 .b or,
d1 a1 )+ .b move, d3 d2 .b or, d2 a1 )+ .b move, ( split into 2 nybbles )
14 #n d0 .b cmp, eq if, d2 a1 )+ .b move, d2 a1 )+ .b move, then,
d0 nt -until, next;
( addr --- ,load format from packet in text at addr ) ( tlh 7/2:17:21 )
code getpkt sp )+ a0 move, 1 #n a0 addq,
%long %lsp - 1- #n d1 moveq, #lsp #n a1 move,
a0 )+ d0 .b move, 4 #n d0 .b rol, a0 )+ d0 .b and, d0 a1 )+ .b move,
2 #n a0 addq, ( skip second byte in packet as meaningless -- see makepkt )
begin, a0 )+ d0 .b move, 4 #n d0 .b rol,
a0 )+ d0 .b and, d0 a1 )+ .b move,
14 #n d1 .b cmp, eq if, 1 #n a1 subq, then, d1 nt
-until, next;
( tlh 5/11:8:57 )
code ^dfmt 0 #n d0 moveq,
a0 )+ d0 .b move, 4 #n d0 .b rol, a0 )+ d0 .b and,
d0 #long .w move, a0 )+ d0 .b move, 4 #n d0 .b rol, a0 )+ d0 .b and,
d0 #above .b move, a0 )+ d0 .b move, 4 #n d0 .b rol, a0 )+ d0 .b and,
d0 #below .b move, a0 )+ d0 .b move, 0f #n d0 .b and, d0 #lock .b move,
a0 )+ d0 .b move, f8 #n d0 .b cmp, cs if, 0f #n d0 .b and, then,
8 #n d0 .w asl,
a0 )+ d0 .b move, 4 #n d0 .b rol, a0 )+ d0 .b and, d0 #ipage .w move,
a0 )+ d0 .b move, f8 #n d0 .b cmp, cs if, 0f #n d0 .b and, then,
8 #n d0 .w asl, a0 )+ d0 .b move,
4 #n d0 .b rol, a0 )+ d0 .b and, d0 #iprint .w move, rts, ;c
( address register usage on wrap
reg hi lo
a0 --- current wrap character position -----
a1 --- character width lookup table ptr ----
a2 --- points to control/format array ------
a3 ---- unused -----------------------------
a4 ---- unused -----------------------------
a5 --- temp storage for wrap position -----
a6 ---- unused -----------------------------
a7 --- unused, stack pointer ---------------
data register usage on wrap
reg hi lo
d0 0 read byte used as index
d1 unused counts bytes during endline unwrap/rewrap
d2 old spr spr < relative spacing >
d3 unused text character count
d4 --- last wrap start address -------------
d5 --- wraplim to stop wrapping process -----
d6 unused counter for decimal tab stop calculations
d7 unused lnl )
code wrap ( tlh 7/1:13:12 )
(regs d4 d5 d6 d7 a2 a5 to) sp -) movem,
tc' cwides 2+ #n a1 move, ( character width table )
#ctrl #n a2 move, ( ptr to control/format table )
i' wraplim d5 move, i' wraplim clr, ( d5=wrap limit )
a2 %wr )d a0 move, ( a0=wrap start )
0 #n d7 moveq, a2 %lnl )d d7 .w move, ( d7=lnl )
a2 %spr )d d2 .b move, ( d2=spr )
#wide d3 .b move, ( d3=char down counter, assume normal wide )
d3 d6 .b move, #left d6 .b add, ( d6=absolute char position )
a0 d4 move, ( save wrap addr )
begin, a0 -) d0 .b move, &lastchr 1+ #n d0 .b cmp, nc ( back to last char)
while, &skip #n d0 .b cmp, eq if, tc' ^sk< jsr, then,
again,
d4 a0 move, ( restore wrap address )
rtn 1+ #n d0 .b cmp, cs ( use indent width on new paragraph )
if, ds #n d0 .b cmp, nc
if, #iwide d3 .b move, d3 d6 .b move, #indent d6 .b add, then,
then,
begin, ( wrap until passing limit address )
a0 d4 move, ( save beginning wrap address )
d2 d0 move, d2 swap, d0 d2 .w move, ( save old spr )
1 #n d7 .w addq, ( incr half-line local count )
( process all format packets before wrapping line,
usually following a cr/pb/ds char )
a0 ) d0 .b move, &lastchr 1+ #n d0 .b cmp, nc
if, begin, a0 )+ d0 .b move, &lastchr 1+ #n d0 .b cmp, nc
while, &fmt #n d0 .b cmp, eq
if, tc' ^fmt> jsr, #iwide d3 .b move, d3 d6 .b move, #indent d6 .b add,
a2 %lsp )d d2 .b move,
else, tc' ^fmt> jsr,
then,
again, 1 #n a0 subq,
then,
( local linecount=0 for real text line, =1 null, =2 or =3 are half-lines)
1 #n d2 .b subq, ( countdown relative spacing until 0 ) 2 pl .w bra,
a2 %lsp )d d2 .b move, ( counts off half-lines )
pb 1+ #n d0 .b cmp, cs ( line consists of one page break )
if, ds #n d0 .b cmp, nc ( or of one document separator )
if, eq ( document separator )
if, 1 #n a0 addq, a1 sp -) move, a2 sp -) move, d0 sp -) move,
#long #n a1 move, #pctrl %long + #n a2 move,
esize %long - 2/ 1- #n d0 moveq,
begin, a1 )+ a2 )+ .w move, d0 nt -until, tc' ^dfmt jsr,
sp )+ d0 move, sp )+ a2 move, sp )+ a1 move,
else, 1 #n a0 addq, ( beyond pb )
then, #iwide d3 .b move, ( set indent ) d3 d6 .b move, #indent d6 .b add,
0 bra,
then,
then,
#long d7 .w cmp, gt ( soft page encountered )
if, 0 :l
a2 %pg )d #pctrl %pg + move, a2 %pgl )d #pctrl %pgl + move,
1 #n d7 .w subq, d7 #pctrl %lnl + .w move, a2 %lnl )d d7 .w sub,
1 #n d7 .w addq, d7 #ln add,
1 #n #pg addq, 1 #n #pgl addq, ds #n d0 .b cmp, eq
if, #pgl clr, then,
a2 %lsp )d d2 .b move, ( spr=lsp, restart linespacing for new page )
0 #n d7 moveq, ( lnloc=0 ) a2 %lnl )d .w clr,
2 .w bra, ( page break is one text line, go to end-wrap test )
then,
0 #n d0 moveq, ( high bits clear as index reg )
begin, ( big loop executes until line termination occurs )
begin, ( outer loop processes high-bit set characters )
begin, ( inner loop counts off normal characters )
a0 )+ d0 .b move, a1 d0 0 xw)d d3 .b sub, nc
( two copies of same instructions for speed )
while, a0 )+ d0 .b move, a1 d0 0 xw)d d3 .b sub, cs
until, &lastchr 1+ #n d0 .b cmp, nc ( may be skip )
while, 1 #n d3 .b subq, ( inner loop subtracted 255 ) tc' ^fmt> jsr,
again, ( falls out of loop for tab/cr/pb/ds or char ct in d3 < 0 )
tb #n d0 .b cmp, eq ( tab character )
lwhile, 3 #n d3 .b subq, ( tab char ) cs if, lleave, then, ( end of line )
#tabs #n a5 move, d3 d6 .b sub, ( d6=current half-char count )
0 #n d1 moveq, d3 swap, d6 d1 .b move, d1 d0 move, 4 #n d1 .w lsr,
d1 a5 add, 1 #n d0 .w lsr, d0 d1 move, 7 #n d0 .b and,
begin, a5 )+ d3 .b move,
begin, d0 d3 btst, eq
while, 1 #n d1 .w addq, 1 #n d0 .b addq, 7 #n d0 .b and, eq
until, eq
while, #tabs 0a + #n a5 cmp, nc
until, d3 swap, d3 d6 .b add, d1 d1 .w add, d6 d1 .b cmp, nc
if, 0 #n d3 moveq, ( no further tab stops, end line )
else, d3 d6 .b sub, d6 d1 .b sub, d3 d6 .b add, d0 a5 9 )d .b btst, ne
if, a0 a5 move, ( decimal tab look ahead )
begin, a0 )+ d0 .b move, &skip #n d0 .b cmp, eq if, tc' ^sk> jsr, then,
i' dpoint 3 + d0 .b cmp, ne
while, 21 #n d0 .b cmp, nc
while, e0 #n d0 .b cmp, cs if, 2 #n d1 .b subq, then,
again, a5 a0 move, d1 .b tst, mi if, 0 #n d1 moveq, then,
then, d1 d3 .b sub, ( downcount reduced bye half-bls used by tab )
then,
cs until, ( line termination exits this loop )
a2 %wide )d d3 .b move, ( set up width for next wrap line )
d3 d6 .b move, a2 %left )d d6 .b add,
( CR is included as last char in line )
rtn #n d0 .b cmp, eq ( if so, next left margin is indent size)
if, a2 %iwide )d d3 .b move,
d3 d6 .b move, a2 %indent )d d6 .b add,
2 .w bra, then,
tb #n d0 .b cmp, eq if, 1 #n a0 subq, 2 .w bra, then,
pb 1+ #n d0 .b cmp, cs ( page-break or document separator )
if, ds #n d0 .b cmp, nc ( must go on separate 1-char next line)
if, 1 #n a0 subq, 2 .w bra, then,
then,
( Reaching this point indicates that #wide, default 80, characters
have been counted. For this purpose, tabs are considered to
be multi-count characters. Now the beginning of the first
word overlapping the line limit is sought by scanning back
across blanks and then non-blank )
d1 d1 .w sub, ( counter of blanks at line end )
( count blanks moving backwards )
a0 a5 move, 1 #n a5 subq, ( remember while scanning backward )
begin, a0 d4 cmp, eq ( do not pass line start )
if, a5 a0 move, 2 .w bra, then,
begin, a0 -) d0 .b move, &lastchr 1+ #n d0 .b cmp, nc
while, &skip #n d0 .b cmp, eq if, tc' ^sk< jsr, then, again,
1 #n d1 .w addq, ( count blanks passed, +1 )
spc 1+ #n d0 .b cmp, nc
until, ( non-blank text character )
4 #n d1 .w cmp, nc ( means 3 or more were counted )
if, a5 a0 move, 2 .w bra, then, ( just chop back to 'wide' chars )
begin, a0 d4 cmp, eq ( went to beginning of line )
if, a5 a0 move, 2 .w bra, then, ( past last non-blank )
begin, a0 -) d0 .b move, &lastchr 1+ #n d0 .b cmp, nc
while, &skip #n d0 .b cmp, eq if, tc' ^sk< jsr, then,
again, spc 1+ #n d0 .b cmp, cs
until, ( now preceding next wrap line )
1 #n a0 addq, ( forward to first text character )
begin, a0 )+ d0 .b move, &lastchr 1+ #n d0 .b cmp, nc
while, tc' ^fmt> jsr, again,
1 #n a0 subq, ( back up to text char ) 2 :l
d5 a0 cmp, gt
until, ( limit address stops wrap pointing beyond limit )
#pctrl #n a1 move, d7 d0 move, #lnl d0 .w sub, #ln d0 add,
d0 a2 %ln )d move, 1 #n d0 subq, d0 a1 %ln )d move,
esize %lsp - 2/ 1- #n d0 moveq,
d7 a2 %lnl )d .w move, ne ( not at page start, old/new pages same )
if, a2 %pg )d a1 %pg )d move, a2 %pgl )d a1 %pgl )d move,
1 #n d7 .w subq, d7 a1 %lnl )d .w move,
else, a2 %pgl )d tst, ( don't backup docinfo if last ch=doc )
eq if, %long %lsp - 2/ 1- #n d0 moveq, then,
then,
d2 a2 %spr )d .b move, ( spr ) d2 swap, d2 a1 %spr )d .b move,
d4 a1 %wr )d move, ( last wrapped line )
%lsp #n a1 add, %lsp #n a2 add, ( a1=old-format array, a2=new-format array )
begin, a2 )+ a1 )+ .w move, d0 nt -until, ( copy new forms into old )
begin, a0 )+ d0 .b move, &lastchr 1+ #n d0 .b cmp, nc
while, tc' ^fmt> jsr, again,
( paragraph formats are altered in fmt subroutine as needed )
1 #n a0 subq, a0 #wr move,
(regs d4 d5 d6 d7 a2 a5 from) sp )+ movem, next;
( tlh 3/05:17:14 )
code brk+ ( addr --- addr1 ,returns addr next possible fmt pkt )
sp )+ a0 move, ds #n a0 )+ .b cmpi, eq
if, dpktsize 1- #n a0 add, then, a0 sp -) move, next;
code ^prevchar ( -- | uses regs a0 and d0 )
begin, a0 -) d0 .b move, &firstacc #n d0 .b cmp, nc
while, &skip #n d0 .b cmp, eq if, tc' ^sk< jsr, then,
again, rts, ;c
code ^nextchar ( -- | uses regs a0 and d0 )
1 #n a0 addq, ( find next text char )
begin, a0 )+ d0 .b move, &firstacc #n d0 .b cmp, nc
while, &skip #n d0 .b cmp, eq if, tc' ^sk> jsr, then,
again, 1 #n a0 subq, rts, ;c
code prevchar ( addr -- addr' | find addr of previous text char )
sp ) a0 move, tc' ^prevchar jsr, a0 sp ) move, next;
code nextchar ( addr -- addr' | find addr of next text char )
sp ) a0 move, tc' ^nextchar jsr, a0 sp ) move, next;
( tlh 3/17:13:47 )
( pos --- ,places full screen vert line at byte position pos on screen)
code vtline sp )+ d0 move, /scan #n d0 .w cmp, nc if, next, then,
screenstart #n a0 move, d0 a0 add,
f7 100 - #n d1 moveq, ( 'and' bit makes one dot ) vtbuff #n a1 move,
/scan #n d2 moveq, vbheight 1- #n d3 .w move,
a0 a1 )+ move, ( save pos of first modified byte at start of buffer )
begin, a0 ) a1 )+ .b move, d1 a0 ) .b and, d2 a0 add, d3 nt -until,
next;
( tlh 3/17:13:46 )
code unvtline vtbuff #n a1 move, a1 ) a0 move, ( get first position )
a1 )+ clr, screenstart #n a0 cmp, cs if, next, then,
screenstart /scan + #n a0 cmp, nc if, next, then, ( range check....)
/scan #n d2 moveq, vbheight 1- #n d3 .w move,
begin, a1 )+ a0 ) .b move, d2 a0 add, d3 nt -until, ( bytes w/o bits set)
next;
( tlh 6/6:10:39 )
: getkey
local oldplay playback? oldplay to
#tabs ##ctrl %tabs + tabcount move ( because fixivl will alter tabs )
begin fixivl <?k> playback? oldplay <> or
until scancode ( tab/left/right/indent/spacing/style? )
##ctrl %tabs + #tabs tabcount move ( restore tabs to original condition )
<?k> 0= if 0 exit then ( fall out when learn ends )
dup 2 = over 38 = or
curop %sett <> if over 32 = or then
over 29 = or over 31 = or swap 0b = or
if 0 exit then ( do not process other format command key ) -1
<key> 0ffff and thiskey to
thiskey lastkey <> thiskey ff80 < and if set-auto then thiskey lastkey to ;
: initkey ff lastkey to ;
: waitkey ( -- , doesn't return until a key event happens )
begin <?k> until ;
( tlh 7/9:14:13 )
( addr count --- ,change all lower case alpha to upper )
code uppercase sp )+ d0 move, sp )+ a0 move, i' maptable a1 move,
1 #n d0 subq, mi if, next, then, ( must be at least one character )
begin, 0 #n d1 moveq,
begin, a0 )+ d1 .b move, 61 #n d1 .b cmp, nc
if, a1 d1 0 xw)d d2 .b move, ne if, d2 a0 -1 )d .b move, then,
then, d0 nt
-until, 10000 #n d0 sub, mi
until, next;
( tlh 7/9:14:32 )
( addr count --- ,change all upper case alpha to lower )
code lowercase sp )+ d0 move, sp )+ a0 move,
1 #n d0 subq, mi if, next, then, ( must be at least one character )
begin, 0 #n d1 moveq,
begin, a0 )+ d1 .b move, 41 #n d1 .b cmp, nc
if, 5b #n d1 .b cmp, cs
if, 20 #n d1 .b add,
else, 80 #n d1 .b cmp, eq if, 7 #n d1 .b addq, then, ( 80==>87 )
83 #n d1 .b cmp, eq if, 1 #n d1 .b addq, then, ( 83==>84 )
88 #n d1 .b cmp, eq if, 1 #n d1 .b addq, then, ( 88==>89 )
8d #n d1 .b cmp, eq if, 1 #n d1 .b subq, then, ( 8d==>8c )
92 #n d1 .b cmp, eq if, 1 #n d1 .b subq, then, ( 92==>91 )
8f #n d1 .b cmp, eq if, 86 #n d1 .b move, then, ( 8f==>86 )
then, d1 a0 -1 )d .b move,
then, d0 nt
-until, 10000 #n d0 sub, mi
until, next;
( tlh 6/4:16:31 )
( addr count --- ,count all characters needing modifier byte )
code extramods sp )+ d0 move, ( d0=count ) 0 #n d2 moveq,
sp )+ a0 move, ( a0=start addr ) 0 #n d1 moveq, ( mod byte counter )
1 #n d0 subq, mi if, d1 sp -) move, next, then, ( must be > 0 chars )
d4 sp -) move, 20 #n d4 moveq, d5 sp -) move, 9f #n d5 move,
d6 sp -) move, 10 #n d6 moveq, d7 sp -) move, -8 #n d7 moveq,
begin, ( see if each char in region needs a following mod byte )
begin, a0 )+ d3 .b move, d4 d3 .b sub, d5 d3 .b cmp, cs ( text char)
if, a0 ) d3 .b move, d6 d3 .b add, d7 d3 .b sub, d2 d1 addx, then,
d0 nt -until, 10000 #n d0 sub, mi
until, sp )+ d7 move, sp )+ d6 move, sp )+ d5 move, sp )+ d4 move,
d1 sp -) move, next;
( tlh 6/4:16:30 )
( from to count modbyte --- ,move inserting modifier follow bytes )
code movewith
sp )+ d1 move, 1 #n d1 .w lsr, e8 #n d1 .b add, ( d1=modifier byte )
sp )+ d0 move, ( d0=count of bytes in region moved )
sp )+ a1 move, sp )+ a0 move, ( a0=from, a1=to )
a0 d0 add, ( limit of moving region ) 20 #n d3 moveq, ( lowest printable ch)
d4 sp -) move, &lastchr 20 - 100 - #n d4 moveq, ( d3+d4:upper printable char )
d5 sp -) move, &attr 100 - #n d5 moveq, ( d5=lowest modifier byte )
d6 sp -) move, tb #n d6 moveq, ( tabs will also take modifier attributes )
begin, a0 )+ d2 .b move, d2 a1 )+ .b move, d6 d2 .b cmp, 0 eq bra, ( tab mod )
d3 d2 .b sub, d4 d2 .b cmp, cs ( in modifiable range )
if, 0 :l a0 ) d2 .b move, d5 d2 .b cmp, nc ( already has attribute byte )
if, d0 a0 cmp, nc if, d1 a1 )+ .b move, leave, then, 1 #n a0 addq,
d1 d2 .b or, d2 a1 )+ .b move,
else, d1 a1 )+ .b move,
then,
then, d0 a0 cmp, nc
until,
sp )+ d6 move, sp )+ d5 move, sp )+ d4 move, a1 sp -) move, next;
( from to count modbyte --- ,move removing unneeded modifier bytes)
code movenotwith
sp )+ d1 move, 1 #n d1 lsr, d1 d2 move, d2 .b not, ( used to remove bit)
e8 #n d1 .b add, ( d1=modifier byte )
sp )+ d0 move, ( d0=count of bytes in region moved )
sp )+ a1 move, sp )+ a0 move, ( a0=from, a1=to )
1 #n d0 subq, mi if, a1 sp -) move, next, then, ( must be > 0 bytes )
10 #n d3 moveq, d4 sp -) move, -8 #n d4 moveq, d5 sp -) move,
begin,
begin, a0 )+ d5 .b move, d5 a1 )+ .b move, d3 d5 .b add, d4 d5 .b cmp, nc
if, d3 d5 .b sub, d1 d5 .b cmp, eq ( modifier match is discarded )
if, 1 #n a1 subq, else, d2 a1 -1 )d .b and, then,
then, d0 nt
-until, 10000 #n d0 sub, mi
until, sp )+ d5 move, sp )+ d4 move, a1 sp -) move, next;
( tlh 6/4:8:01 )
code attribregion ( addr count ovmodtype --- flag ,true if default char op )
sp )+ d1 move, 1 #n d1 .w lsr, ( d1=modifier byte )
sp )+ a1 move, ( bytes in region ) sp ) a0 move, ( start) sp ) clr,
a0 a1 add, ( a1:limit of test region ) 20 #n d3 moveq, ( lowest printable ch)
d4 sp -) move, &lastchr 20 - 100 - #n d4 moveq, ( d3+d4:upper printable char )
tb #n d0 moveq, ( tabs will also take modifier attributes )
begin, a0 )+ d2 .b move, d0 d2 .b cmp, 0 eq bra, ( tab mod )
d3 d2 .b sub, d4 d2 .b cmp, cs ( in modifiable range )
if, 0 :l a1 a0 cmp, nc if, sp )+ d4 move, 1 #n sp ) subq, next, then,
&attr #n a0 ) .b cmpi, nc ( already has attribute byte )
if, a0 )+ d2 .b move, d1 d2 .b and, eq
if, sp )+ d4 move, 1 #n sp ) subq, next, then,
else, sp )+ d4 move, 1 #n sp ) subq, next, ( no attrib byte also fails )
then, ( stops with true if any unset character is found )
then, a1 a0 cmp, nc
until, sp )+ d4 move, next;
( tlh 7/9:14:38 )
code capregion ( addr count --- flag ,true if a lower case char in region )
sp )+ d3 move, sp ) a0 move, a0 d3 add, 60 #n d1 moveq, 0 #n d2 moveq,
sp ) clr, ( assume no lower case in region ) i' maptable a1 move,
begin, a0 )+ d2 .b move, d2 d1 .b cmp, cs
if, a1 d2 0 xw)d .b tst, ne if, 1 #n sp ) subq, next, then, then,
d3 a0 cmp, nc
until, next;
: makedefdpkt ( addr -> | make an initial document packet at addr)
[ idocpkt ] literal swap dpktsize move ;
( tlh 3/09:16:09 )
code makedpkt sp )+ a0 move, ds #n a0 )+ .b move, #ctrl #n a1 move,
a1 %long )d d0 .w move, d0 d1 .b move, 4 #n d0 .b lsr, fff0 #n d2 .w move,
d2 d0 .b or, d0 a0 )+ .b move, d2 d1 .b or, d1 a0 )+ .b move,
a1 %above )d d0 .b move, d0 d1 .b move, 4 #n d0 .b lsr,
d2 d0 .b or, d0 a0 )+ .b move, d2 d1 .b or, d1 a0 )+ .b move,
a1 %below )d d0 .b move, d0 d1 .b move, 4 #n d0 .b lsr,
d2 d0 .b or, d0 a0 )+ .b move, d2 d1 .b or, d1 a0 )+ .b move,
a1 %lock )d d0 .b move, d2 d0 .b or, d0 a0 )+ .b move,
a1 %ipage )d d0 .w move, d0 d1 move, 4 #n d0 .w lsr, d0 d3 move,
4 #n d3 .w lsr, d2 d3 .b or, d3 a0 )+ .b move, d2 d0 .b or,
d0 a0 )+ .b move, d2 d1 .b or, d1 a0 )+ .b move,
a1 %iprint )d d0 .w move, d0 d1 move, 4 #n d0 .w lsr, d0 d3 move,
4 #n d3 .w lsr, d2 d3 .b or, d3 a0 )+ .b move, d2 d0 .b or,
d0 a0 )+ .b move, d2 d1 .b or, d1 a0 )+ .b move, next;
( tlh 3/09:16:04 )
code getdpkt sp )+ a0 move, 1 #n a0 addq, tc' ^dfmt jsr, next;
code getdocpak ( get setup values for document values into control variables)
#ctrl #n a1 move, ( pick up base address)
i' ipage# 2+ a1 %ipage )d .w move,
i' iprint# 2+ a1 %iprint )d .w move,
i' hllong 2+ a1 %long )d .w move,
i' hlabove 3 + a1 %above )d .b move,
i' hlbelow 3 + a1 %below )d .b move,
next;
( tlh 3/09:14:59 )
( save formats in undo buffer which has been preset to correct size )
code savedpkts
i' bou a1 move, ( destination of moved packets )
i' prepkt a0 move, ( source of format packets in text )
i' gap d0 move, ( limit of source interval )
ef 100 - #n d2 moveq, ( d2=test for packet data byte )
dpktsize 1- #n d1 moveq, ( d1=packet body size )
a2 sp -) move, ( need for scanning inner loop )
begin, d1 a0 add, d0 a0 cmp, cs ( still in text region? )
while, a0 ) d2 .b cmp, cs ( maybe in packet )
if, a0 a2 move, d1 a2 sub, ds #n d2 moveq, ( back up to packet )
begin, a2 )+ d2 .b cmp, eq ( found packet leader byte )
if, d1 d3 move, 1 #n d3 .w subq,
begin, a2 )+ a1 )+ .b move, d3 nt -until,
then, ( one packet moved into undo buffer ) a0 a2 cmp, nc
until, ef 100 - #n d2 moveq,
then,
again, sp )+ a2 move, next;
( tlh 3/09:14:56 )
( swap format pkts in range with corresponding pkts in undo buffer )
code swapdpkts
i' bou a1 move, ( destination of moved packets )
i' prepkt a0 move, ( source of format packets in text )
i' gap d0 move, ( limit of source interval )
ef 100 - #n d2 moveq, ( d2=test for packet data byte )
dpktsize 1- #n d1 moveq, ( d1=packet body size )
a2 sp -) move, ( need for scanning inner loop )
begin, d1 a0 add, d0 a0 cmp, cs ( still in text region? )
while, a0 ) d2 .b cmp, cs ( maybe in packet )
if, a0 a2 move, d1 a2 sub, ds #n d2 moveq, ( back up to packet )
begin, a2 )+ d2 .b cmp, eq ( found packet leader byte )
if, d1 d3 move, 1 #n d3 .w subq,
begin, a2 ) d2 .b move, a1 ) a2 )+ .b move, d2 a1 )+ .b move, d3 nt
-until, ( switch bytes in corresponding packets )
then, ( one packet moved into undo buffer ) a0 a2 cmp, nc
until, ef 100 - #n d2 moveq,
then,
again, sp )+ a2 move, next;
( tlh 3/13:17:57 )
( start limit --- count ,returns bytes of document packets in region )
code dpktbytes 0 #n d3 moveq, ( d3=counter )
sp )+ d0 move, ( d0=region limit ) sp )+ a0 move, ( start of range )
ef 100 - #n d2 moveq, ( d2=test for packet data byte )
dpktsize 1- #n d1 moveq, ( d1=packet body size )
begin, d1 a0 add, d0 a0 cmp, cs ( examine text until passing limit )
while, a0 ) d2 .b cmp, cs ( maybe in packet )
if, a0 a1 move, d1 a1 sub, ds #n d2 moveq,
begin, a1 )+ d2 .b cmp, eq ( found packet leader byte )
if, d1 d3 add, leave, then, ( total # of packet bytes ) a0 a1 cmp, eq
until, ef 100 - #n d2 moveq,
then,
again, d3 sp -) move, next;
( start limit --- count ,returns number of bytes of format in region )
code pktbytes 0 #n d3 moveq, ( d3=counter )
sp )+ d0 move, ( d0=region limit ) sp )+ a0 move, ( start of range )
ef 100 - #n d2 moveq, ( d2=test for packet data byte )
pktsize 1- #n d1 moveq, ( d1=packet body size )
begin, d1 a0 add, d0 a0 cmp, cs ( examine text until passing limit )
while, a0 ) d2 .b cmp, cs ( maybe in packet )
if, a0 a1 move, d1 a1 sub, e2 100 - #n d2 moveq,
begin, a1 )+ d2 .b cmp, eq ( found packet leader byte )
if, d1 d3 add, leave, then, ( total # of packet bytes ) a0 a1 cmp, eq
until, ef 100 - #n d2 moveq,
then,
again, d3 sp -) move, next;
( save formats in undo buffer which has been preset to correct size )
code savepkts
i' bou a1 move, ( destination of moved packets )
i' prepkt a0 move, ( source of format packets in text )
i' gap d0 move, ( limit of source interval )
i' postpkt d1 move, d1 d0 cmp, nc if, d1 d0 move, then, ( smaller addr )
ef 100 - #n d2 moveq, ( d2=test for packet data byte )
pktsize 1- #n d1 moveq, ( d1=packet body size )
a2 sp -) move, ( need for scanning inner loop )
begin, d1 a0 add, d0 a0 cmp, cs ( still in text region? )
while, a0 ) d2 .b cmp, cs ( maybe in packet )
if, a0 a2 move, d1 a2 sub, e2 100 - #n d2 moveq, ( back up to packet )
begin, a2 )+ d2 .b cmp, eq ( found packet leader byte )
if, d1 d3 move, 1 #n d3 .w subq,
begin, a2 )+ a1 )+ .b move, d3 nt -until,
then, ( one packet moved into undo buffer ) a0 a2 cmp, nc
until, ef 100 - #n d2 moveq,
then,
again, sp )+ a2 move, next;
( swap format pkts in range with corresponding pkts in undo buffer )
code swappkts
i' bou a1 move, ( destination of moved packets )
i' prepkt a0 move, ( source of format packets in text )
i' gap d0 move, ( limit of source interval )
i' postpkt d1 move, d1 d0 cmp, nc if, d1 d0 move, then,
ef 100 - #n d2 moveq, ( d2=test for packet data byte )
pktsize 1- #n d1 moveq, ( d1=packet body size )
a2 sp -) move, ( need for scanning inner loop )
begin, d1 a0 add, d0 a0 cmp, cs ( still in text region? )
while, a0 ) d2 .b cmp, cs ( maybe in packet )
if, a0 a2 move, d1 a2 sub, e2 100 - #n d2 moveq, ( back up to packet )
begin, a2 )+ d2 .b cmp, eq ( found packet leader byte )
if, d1 d3 move, 1 #n d3 .w subq,
begin, a2 ) d2 .b move, a1 ) a2 )+ .b move, d2 a1 )+ .b move, d3 nt
-until, ( switch bytes in corresponding packets )
then, ( one packet moved into undo buffer ) a0 a2 cmp, nc
until, ef 100 - #n d2 moveq,
then,
again, sp )+ a2 move, next;
( tlh 6/2:16:20 )
( start limit --- addr or zero, return address of first break in region )
code firstbreak sp )+ d0 move, sp )+ a0 move,
rtn #n d1 moveq, ( to test for rtn, pb, ds chars )
begin, a0 )+ d1 .b cmp, nc ( not printable ascii )
if, ds #n a0 -1 )d .b cmpi, nc ( but not tab )
if, 1 #n a0 subq, d0 a0 cmp, cs if, a0 sp -) move, next, then,
then,
then, d0 a0 cmp, nc
until, sp -) clr, next;
( start limit --- addr or zero, return address of last break in region )
code lastbreak sp )+ a0 move, sp )+ d0 move, ( a0=endpt, d0=start)
rtn #n d1 moveq,
begin, a0 -) d1 .b cmp, nc
if, ds #n a0 ) .b cmpi, nc
if, a0 sp -) move, next, then,
then, d0 a0 cmp, eq
until, sp -) clr, next;
( tlh 5/23:10:47 )
: prevbrk ( addr -- addr' )
dup beot 1+ <
if text swap gap min lastbreak
else beot swap lastbreak ?dup 0= if text gap lastbreak then
then ;
( tlh 5/23:10:48 )
: nextbrk ( addr -- addr' )
nextchar dup gap >
if endtext firstbreak
else gap firstbreak ?dup 0= if beot endtext firstbreak then
then ;
code selsize i' gap d0 move, i' bos d0 sub, d0 sp -) move, next;
code preset ( put skip character and offset both sides of gap )
i' beot a1 move, a1 d3 move, i' gap a0 move, a0 d2 move,
&skip #n a0 )+ .b move, a1 d0 move, a0 d0 sub, d0 d1 move,
3 #n d1 subq, ( d1=dist to right)
d1 a0 2 )d .b move, 8 #n d1 .w lsr, d1 a0 1 )d .b move, d1 swap,
d1 a0 ) .b move, ( left side pointer in place )
&skip #n a1 -) .b move, d0 a1 -) .b move, 8 #n d0 .w lsr,
d0 a1 -) .b move, d0 swap, d0 a1 -) .b move, ( bytes in reverse order )
i' text d2 sub, isize #n d2 .w divu, esize #n d2 .w mulu,
#itbl #n d2 add, d2 i' gapivl move,
i' text d3 sub, isize #n d3 .w divu, esize #n d3 .w mulu,
#itbl #n d3 add, d3 i' beotivl move,
next;
code loadline sp )+ d0 move, ( d0=screen line number )
esize #n d0 .w mulu, ( get window addr) #wtable #n d0 add,
d0 a0 move, #ctrl #n a1 move, ( a1=ctrls array)
a0 esize %wr + )d #nextwr move,
( build also needs start of next line )
esize 4 / 1- #n d0 moveq,
begin, a0 )+ a1 )+ move, d0 nt -until,
( transfer state bytes to active vars from window line ) next;
code storeline sp )+ d0 move, ( d0=screen line number )
esize #n d0 .w mulu, ( addr in window array ) #wtable #n d0 add,
d0 a0 move, #ctrl #n a1 move, ( a1=current formats/controls )
esize 4 / 1- #n d0 moveq, begin, a1 )+ a0 )+ move, d0 nt -until,
( transfer state bytes from active into window ) next;
( n --- ,set update bit for line n of screen )
code update! sp )+ a0 move, #update #n a0 add, -80 #n d0 moveq,
d0 a0 ) .b or, next;
( n --- flag ,true if update needed for half-line n and non-null )
code update? sp ) a0 move, #update #n a0 add, a0 ) d0 .b move,
a0 ) .b clr, d0 d0 .b add, d0 d0 subx, d0 sp ) move, next;
code inwindow sp ) d0 move, #wtable %wr + #n a0 move, ( 1st line addr )
a0 ) d0 cmp, cs if, sp ) clr, next, then, ( precedes window )
a0 lastline esize * )d a0 lea, a0 ) d0 cmp, ge
if, sp ) clr, next, then, ( beyond window )
lastline #n d1 moveq, esize #n d2 moveq, ( check tbl from end )
begin, d2 a0 sub, 1 #n d1 subq, a0 ) d0 cmp, nc until, ( wrap >= d0 )
d1 sp ) move, ( d1=found line number ) -1 #n d0 moveq,
d0 sp -) move, next; ( true flag first if found in window )
( tlh 5/10:15:41 )
( addr --- flag ,returns true if addr in visible part of window array)
: visible? inwindow
if firstseen lastseen 1- inrange else 0 then ;
( copy previous wrap state into current state )
code prevwrap #pctrl #n a1 move, #ctrl #n a0 move,
esize 4 / 1- #n d0 moveq, begin, a1 )+ a0 )+ move, d0 nt -until,
next;
( d1=xposition in half characters
a0=address area to move
a1=working address
d2=hold of address )
code <cursoron> ( -- | turn cursor on in text )
-1 #n i' cursorstate move, ( set state of cursor to on )
i' cx d1 move,
i' cy d2 move,
pl lif, /scan scans/image 2/ * #n d2 .w mulu, ( this number is in halflines)
screenstart #n d2 add, ( add to the start of the screen )
d2 a0 move, ( a2 points to first line of cursor )
d1 d0 move,
1 #n d0 lsr, ( the x is in half characters [bytes] )
d0 a0 add, ( a0=byte to start saving )
a0 d2 move, ( and save in d2 for putting in the cursor )
cursorbuf #n a1 move, ( a1=buffer to hold cursor )
scans/image 1- #n d3 move, ( number of bytes to move )
begin, ( save what was under the cursor )
a0 )+ a1 )+ .b move, ( save the two bytes under cursor )
a0 ) a1 )+ .b move,
/scan 1- #n a0 add, ( we have already added one to a0 )
d3 nt -until, ( for all the rows fo the font )
d2 a0 move, ( restore address )
i' cwidth tst, ( 0 for 1/2wide, 1 for full width )
eq if,
i' ncursorimage a1 move, ( this could be a special 1/2 wide cursor )
scans/image 1- #n d3 move, ( count for how many to set )
d1 d0 move, ( move cx into d0 for a bit )
f0 #n d1 move, ( mask of byte on screen to clear area )
0f #n d2 move, ( mask for cursor to select half )
1 #n d0 and, ( see if lower or upper half of byte )
eq if, ( if putting in upper half of byte )
d1 d2 exg, ( then exchange masks )
then,
begin,
a1 )+ d0 .b move, ( get cursor image )
d2 d0 and, ( mask out part not needed )
d1 a0 ) .b and, ( mask byte on the screen )
d0 a0 ) .b or, ( and place cursor onto screen )
/scan #n a0 add, ( onto the next line )
d3 nt -until,
else,
i' wcursorimage a1 move, ( get the normal width cursor )
scans/image 1- #n d3 move, ( count of lines )
1 #n d1 and, ( see if even byte boundry )
eq if, ( simple case here )
begin,
a1 )+ a0 ) .b move, ( move mask into place )
/scan #n a0 add, ( move to next line )
d3 nt -until, ( for all the lines )
else, ( hard case. byte straddles boundry )
a0 d0 move, ( check to see if on an even or odd address)
1 #n d0 and,
ne if, ( if odd address )
1 #n a0 subq, ( back off to an even address )
fff00fff #n d1 move, ( set the mask )
0c #n d2 moveq, ( and the shift count for the cursor )
else, ( else on an even address )
f00fffff #n d1 move, ( just set the mask )
14 #n d2 moveq, ( and a smaller shift count )
then,
begin,
0 #n d0 moveq, ( clear out d0 )
a1 )+ d0 .b move, ( and get the cursor image into d0 )
d2 d0 rol, ( rotate it around to the correct spot )
d1 a0 ) and, ( clear out the area in memory )
d0 a0 ) or, ( and put in the cursor image )
/scan #n a0 add, ( onto the next row )
d3 nt -until, ( for all the rows )
then,
then,
then,
i' rulerblink? tst, ( see if we should blink in the ruler )
ne lif, i' cx d0 move, 1 #n d0 .w lsr, ( this is flash for the ruler )
rulerstart 4 + /scan * screenstart + ( ruleredge + ) #n a0 move,
d0 a0 add, ( add byte address to start of ruler )
a0 d2 move, ( save the value of a0 )
cursorbuf scans/image 2* + #n a1 move, ( add image to cursor buf)
hrulercursor 1- #n d3 move, ( for the height of the blink )
begin,
a0 )+ a1 )+ .b move, ( move two bytes away )
a0 ) a1 )+ .b move,
/scan 1- #n a0 add,
d3 nt -until,
d2 a0 move, ( restore address to start )
i' cx d0 move, 1 #n d0 .b and, ( is cursor on half boundry? )
eq if, hrulercursor 1- #n d3 .w move, ( if on an even boundry )
1c #n d0 .b move, ( this is the blink image! )
i' blackruler d2 move, ( get flag for ruler color )
eq if, d0 .b not, then, ( if white, need complement )
begin,
d2 tst, ( check color of ruler )
eq if, d0 a0 ) .b and, ( white, mask out bits )
else, d0 a0 ) .b or, ( black, or bits into ruler )
then,
/scan #n a0 add, ( on to next line )
d3 nt -until,
else, ( cursor is on half boundry )
hrulercursor 1- #n d3 move,
1 #n d0 .b move, ( lower byte of blink image! )
c0 #n d1 .b move, ( upper byte of ruler image! )
i' blackruler d2 move, ( get flag for ruler color )
eq if, d0 .b not, d1 .b not, then, ( if white, need complement )
begin,
d2 tst, ( check ruler color )
eq if, d0 a0 )+ .b and, d1 a0 ) .b and,
else, d0 a0 )+ .b or, d1 a0 ) .b or,
then,
/scan 1- #n a0 add,
d3 nt -until,
then,
then,
next;
code <cursoroff> ( -- )
0 #n i' cursorstate move, ( set state of cursor to on )
i' cx d1 move,
i' cy d2 move,
pl if, /scan scans/image 2/ * #n d2 .w mulu, ( this number is in halflines)
screenstart #n d2 add, ( add to the start of the screen )
d2 a0 move, ( a2 points to first line of cursor )
d1 d0 move,
1 #n d0 lsr, ( the x is in half characters [bytes] )
d0 a0 add, ( a0=byte to start restoring )
cursorbuf #n a1 move, ( a1=buffer holding stuff under cursor )
scans/image 1- #n d3 move, ( number of bytes to move )
begin, ( restore what was under the cursor )
a1 )+ a0 )+ .b move, ( restore the two bytes under cursor )
a1 )+ a0 ) .b move,
/scan 1- #n a0 add, ( we have already added one to a0 )
d3 nt -until, ( for all the rows fo the font )
then,
i' rulerblink? tst, ( see if we should blink in the ruler )
ne if, i' cx d0 move,
1 #n d0 .w lsr, ( this is unflash for the ruler )
rulerstart 4 + /scan * screenstart + ( ruleredge + ) #n a0 move,
d0 a0 add, ( add byte address to start of ruler )
cursorbuf scans/image 2* + #n a1 move, ( add image to cursor buf)
hrulercursor 1- #n d3 move, ( for the height of the blink )
begin,
a1 )+ a0 )+ .b move, ( move two bytes back )
a1 )+ a0 ) .b move,
/scan 1- #n a0 add,
d3 nt -until,
then,
next;
( tlh 7/3:12:23 ) ( jrs 21Dec87 12:09 )
code build ( move formatted line of text to line output buffer )
#wr a0 move, lbuff #n a1 move, ( input and output sources )
a1 ) clr, #lock a1 ) .b move, 4 #n a1 addq,
markbl 100 * #n a1 )+ .w move, a1 )+ .w clr,
i' bos d2 move, i' eos d3 move, 0 #n d1 moveq, ( d1=char mod )
d2 a0 cmp, ge ( start with high bit set if in selection )
if, d3 a0 cmp, lt if, $inv #n d1 .b move, then, then,
pb #n a0 ) .b cmpi, eq ( page display changed numbering )
if, $inv #n d1 .b cmp, eq if, mpb 100 * #n d1 .w or,
else, hardpage 100 * #n d1 .w or,
then, 3 #n d3 moveq,
else, ds #n a0 ) .b cmpi, eq
if, docpage 100 * #n d1 .w or, 2 #n d3 moveq,
lok #n #lock .b cmpi, eq if, d1 a1 -4 )d .w move, then,
lok 0f0 or #n a0 7 )d .b cmpi, eq
if, d1 a1 -4 )d .w move, lok #n a1 -8 )d .b move, then,
else, #long d0 .w move, #lnl d0 .w cmp, le
if, softpage 100 * #n d1 .w move, 4 #n d3 moveq,
else, 0 #n d0 moveq, then,
then,
then, ne ( any page or document break processed here )
lif, &horiz 2/ #n d0 moveq, d4 sp -) move,
begin, d1 a1 )+ .w move, a1 )+ .w clr, d0 nt -until,
lbuff 4 + a1 )+ move,
lbuff a1 )+ .b move, $end #n a1 )+ .b move, a1 ) .w clr, ( fix line end)
#ipage d0 .w move, d0 ext, #pgl d0 add, ( local page # to print )
$half #n d2 move, lbuff &horiz + 0c + #n a1 move, #iprint d4 .w move,
d4 ext, d4 d0 cmp, ge ( show only if will appear on paper also )
lif, d0 d4 move, mi if, d0 neg, then, 0a #n d0 cmp, cs ( <10 )
if, d2 a1 1 )d .b or, d2 a1 -7 )d .b or,
else, 4 #n a1 addq, 64 #n d0 cmp, cs ( <100 )
if, d2 a1 -0b )d .b or, d2 a1 -0f )d .b or,
else, 3e8 #n d0 cmp, cs ( <1000 )
if, d2 a1 1 )d .b or, d2 a1 -0f )d .b or,
else, 4 #n a1 addq, 2710 #n d0 cmp, cs ( <10000 )
if, d2 a1 -13 )d .b or, d2 a1 -17 )d .b or,
else, 186a0 #n d0 cmp, cs ( '100000 )
if, d2 a1 1 )d .b or, d2 a1 -17 )d .b or,
else, 4 #n a1 addq, d2 a1 -1f )d .b or, d2 a1 1 )d .b or,
then,
then,
then,
then,
then,
d3 a1 ) .b move, ( uln-blank at rt)
begin, 0a #n d0 .w divu, d0 swap, 10 #n d0 .b add, d3 a1 -) .w move,
1 #n a1 subq, d0 a1 -) .b move, d0 .w clr, d0 swap, eq
until, ( all digits now written over page mark characters )
d4 tst, mi
if, d3 a1 -) .w move, a1 -) d0 .b move, $half #n d0 .b and, ne
if, $half 0ff xor #n a1 ) .b and, $half #n a1 -8 )d .b or, then,
pg#minus #n a1 -) .b move,
then,
d3 a1 -4 )d .b move, ( underline blank on left )
else, d2 a1 1 )d .b or, d2 a1 5 )d .b or, ( compress unnumbered line )
then, sp )+ d4 move, next,
then,
d4 sp -) move, d5 sp -) move, d6 sp -) move, d7 sp -) move,
a2 sp -) move, a3 sp -) move, a4 sp -) move, a5 sp -) move,
#left d6 .b move, #wide d6 .b add, 1 #n d6 .b lsr, ( checks tab overflow )
a0 a3 move, btable #n a2 move,
begin, a0 -) d0 .b move, e0 #n d0 .b cmp, nc
while, &skip #n d0 .b cmp, eq if, tc' ^sk< jsr, then,
again, ( was the previous character a break? )
a3 a0 move, rtn 1+ #n d0 .b cmpi, nc ( get # padding blanks on left )
if, #left d0 .b move,
else, ds #n d0 .b cmpi, nc
if, #indent d0 .b move, else, #left d0 .b move, then,
then, ( add this many half-spaces on left )
begin, 2 #n d0 .b subq, nc
while, markbl 100 * #n a1 )+ .w move, a1 )+ .w clr, again,
#nextwr a3 move, 0 #n d4 moveq, a3 ) .b d4 move,
1 #n a2 d4 0 xw)d .b subq, ( mark nextwr chr in table )
d2 a4 move, d3 a5 move, ( a4=bos, a5=eos )
0 #n d2 moveq, 0 #n d3 moveq,
a0 a4 cmp, nc ( bos char in this line? )
if, a3 a4 cmp, cs if, a4 ) d2 .b move, then, then, 1 #n a4 addq,
1 #n a2 d2 0 xw)d .b subq, ( mark bos char )
a0 a5 cmp, nc ( eos char in this line? )
if, a3 a5 cmp, cs if, a5 ) d3 .b move, then, then, 1 #n a5 addq,
1 #n a2 d3 0 xw)d .b subq, ( mark eos char )
i' bosptr clr, i' eosptr clr,
begin, ( outer loop processing special chars and locations )
begin, ( scan across text putting characters and modifiers into buffer )
a0 )+ d0 .b move, d0 a1 )+ .b move, d1 a1 )+ .b move, a1 )+ .w clr,
a2 d0 0 xw)d .b tst, mi ( pass eos, bos, nextwr, command, perm. sp, tab )
until, a0 a3 cmp, nc
lwhile, tb #n d0 .b cmp, eq ( process tab char )
lif, 4 #n a1 subq, ( back-up past tab put in buffer )
a0 a4 cmp, eq ( char was at bos )
if, $inv #n d1 .b or, a1 i' bosptr move, then,
a0 a5 cmp, eq ( char was at eos )
if, $inv ff xor #n d1 .b and, a1 i' eosptr move, then,
#tabs #n a2 move, a1 d5 move, lbuff 8 + #n d5 sub, ( offset half-bls)
2 #n d5 .w asr, ( /4 for 4-byte character positions )
d4 swap, d5 d4 .w move, 1 #n d4 .w addq,
d3 swap, 0 #n d0 moveq, d4 d0 .w move, 3 #n d0 .w lsr, d0 a2 add,
d4 d0 .w move, 7 #n d0 .w and,
begin, a2 )+ d3 .b move,
begin, d0 d3 btst, eq
while, 1 #n d4 .w addq, 1 #n d0 .b addq, 7 #n d0 .b and, eq
until, eq
while, #tabs 0a + #n a2 cmp, nc
until,
d6 d4 .b cmp, nc ( tab found was past right boundary )
if, d6 d4 .b move, d5 d4 .b sub, 1 #n d4 .b sub,
else, d5 d4 .b sub, 1 #n d4 .b subq, ( needed filler minus tab-arrow)
d0 a2 9 )d .b btst, ne ( decimal tab )
if, a0 a2 move, ( must look ahead to period or word terminator )
begin, a0 )+ d5 .b move, &skip #n d5 .b cmp, eq if, tc' ^sk> jsr, then,
i' dpoint 3 + d5 .b cmp, ne
while, 21 #n d5 .b cmp, nc ( pick off chars until termination cond )
while, e0 #n d5 .b cmp, cs if, 1 #n d4 .b subq, then,
again, a2 a0 move, ( restore text ptr )
then,
then, $inv #n d1 .b cmp, ne ( in normal mode tabs invisible )
if, tabspace #n d5 moveq, else, tab0 #n d5 moveq, then, a1 d7 move,
begin, 1 #n d4 .b subq, pl ( tab arrow left of arrow-head )
while, d5 a1 )+ .b move, d1 a1 )+ .b move, a1 )+ .w clr,
again, tab0 #n d5 .b cmp, eq
if, tab1 #n d5 moveq, else, tabspace #n d5 moveq, then,
d5 a1 )+ .b move, d1 a1 )+ .b move, ( arrow-head last ) a1 )+ .w clr,
btable #n a2 move, ( restore fast-loop byte table )
d3 swap, d4 swap,
lelse, e9 #n d0 .b cmp, nc ( char modifiers in range e9-ef )
if, f0 #n d0 .b cmp, cs ( modify last character )
if, 7 #n d0 .b and, d0 d0 .b add, d0 a1 -7 )d .b or, 4 #n a1 subq,
tb #n a0 -2 )d .b cmpi, eq
if, a1 sp -) move,
begin, d0 a1 -3 )d .b or, 4 #n a1 subq, a1 d7 cmp, nc until,
sp )+ a1 move,
then,
then,
then,
&firstacc #n d0 .b cmp, nc ( overstrike character onto prev char )
if, &lastacc 1+ #n d0 .b cmp, cs
if, 4 #n a1 subq, d0 a1 -1 )d .b move,
c5 #n d0 .b cmpi, ne
if, c4 #n d0 .b cmpi,
ne if, c7 #n d0 .b cmpi, ( begin 2.23 mod code)
ne if, ascii i #n a1 -4 )d .b cmpi, eq
if, 20 #n a1 -3 )d .b ori, then,
ascii j #n a1 -4 )d .b cmpi, eq
if, 20 #n a1 -3 )d .b ori, then,
then,
then, ( end 2.23 mod code)
then, then,
then,
&fmt #n d0 .b cmp, eq if, lleave, then, ( skip fmts )
a0 a4 cmp, eq ( char was at bos )
if, $inv #n d1 .b or, 4 #n a1 subq, a1 i' bosptr move, 1 #n a1 addq,
d1 a1 )+ .b move, 2 #n a1 addq,
then,
a0 a5 cmp, eq ( char was at eos )
if, $inv ff xor #n d1 .b and, 4 #n a1 subq, a1 i' eosptr move,
1 #n a1 addq, d1 a1 )+ .b move, 2 #n a1 addq,
then,
93 #n d0 .b cmp, eq
if, invbit #n d1 .l btst, ne if, invprm #n a1 -4 )d .b move, then, then,
&skip #n d0 .b cmp, eq ( hop gap ) if, 4 #n a1 subq, tc' ^sk> jsr, then,
&calc #n d0 .b cmp, nc ( skip high bit set chars in calc packet )
if, begin, &lastcmd #n a0 )+ .b cmpi, cs until,
1 #n a0 subq, 4 #n a1 subq,
then,
then,
again,
4 #n a1 subq,
1 #n a2 d2 0 xw)d .b addq, 1 #n a2 d3 0 xw)d .b addq,
1 #n a2 d4 0 xw)d .b addq, ( restore btable )
a0 a0 sub, ( counts blanks taken from right lock-display margin )
a1 d4 move, lbuff 8 + #n d4 sub, 1 #n d4 asr, ( offset in half-bls )
#left d4 .b sub, #wide d4 .b sub, d4 .b neg, ( d4=half-bl's added to right )
0 #n d5 moveq, ( d5=half-bl's added to left side )
#just d3 .b move, ne ( 0=left, 1=right, 2=centered, 3=distributed justify )
lif, 20 #n a1 -4 )d .b cmpi, eq ( blanks on right forced into lock margin)
if, 2 #n a0 .w addq, 2 #n d4 .b addq, 20 #n a1 -8 )d .b cmpi, eq
if, 2 #n a0 .w addq, 2 #n d4 .b addq, then,
then,
rtn #n a1 -4 )d .b cmpi, eq ( same for line ending in cr )
if, 3 #n d3 .b cmp, ne ( except if both-justified )
if, 2 #n a0 .w addq, 2 #n d4 .b addq, then,
then,
1 #n d3 .b subq, eq ( move all excess blanks to left : : 1,right )
if, d4 d5 exg, then,
1 #n d3 .b subq, eq ( move half of excess to left : : 2, cntr)
if, 1 #n d4 .b lsr, d4 d5 move, then,
1 #n d3 .b subq, eq ( uses bresenham's algorithm to distribute half-bls)
lif, rtn #n a1 -4 )d .b cmpi, ne ( only if line is wrapped at end )
lif, rtn #n d0 .b cmpi, nc ( and not followed by pb/ds )
lif, -1 #n d2 moveq, ( counter for words ) jray #n a2 move,
0 #n d1 moveq, a1 a5 move, 20 #n d0 moveq, ( blank detector )
lbuff 8 + #n a3 move, a1 a4 move, d4 a4 add, d4 a4 add,
d4 a4 add, d4 a4 add, ( new rt end)
0 #n d3 moveq, ( counter for chars ) 0 #n d5 moveq, ( last seen char)
begin, 1 #n d3 .b addq, 3 #n a1 subq, a1 -) d1 .b move,
d0 d1 .b cmp, ne ( need non-blank to blank transition )
if, d0 d5 .b cmp, eq
if, d3 a2 )+ .b move, 0 #n d3 moveq, 1 #n d2 .b addq, then,
then, d1 d5 move, tab1 #n d1 .b cmp, ne
while, tabspace #n d1 .b cmp, ne
while, a3 a1 cmp, eq
until, ( recorded word-ends back to start of line or last tab )
a5 a1 move, ( remember lbuff position ) d2 d3 .b move, d3 d2 move,
d2 .b tst, gt ( must have passed at least 2 words, last in line unused )
lif, jray #n a2 move, a2 )+ d0 .b move, 1 #n d0 .b subq,
d0 a2 ) .b add, ( skips over last word in line )
d2 d3 move, 1 #n d3 subq, ( d3=word countdown, d2=slots for bl's )
d4 d5 move, ( d4=extra bl's, d5=counter for bresenham's algorithm )
markbl 100 * #n d1 .w move, a4 a1 move, ( will be lbuff position )
begin, 0 #n d0 moveq, a2 )+ d0 .b move,
1 #n d0 .b subq, ( count of chars going rt )
begin, a5 -) a4 -) move, d0 nt -until, ( place opened for bl's )
a5 1 )d d1 .b move, ( attrib for half-blanks ) $half #n d1 .b add,
begin, d2 d5 .b sub, nc ( bresenham finally, insert half-bl's )
while, a4 -) .w clr, d1 a4 -) .w move,
again, d2 d5 .b add, d4 d5 .b add, d3 nt
-until, ( recorded all possible insertion points for excess spaces )
i' bosptr d0 move, ne
if, d0 a3 move, lbuff #n a2 move,
begin, a2 ) d4 .w move, $half #n d4 .w and,
ne if, 4 #n a3 addq, then, 4 #n a2 addq, a3 a2 cmp, eq until,
a3 i' bosptr move,
then, i' eosptr d0 move, ne
if, d0 a3 move, lbuff #n a2 move,
begin, a2 ) d4 .w move, $half #n d4 .w and, ne
if, 4 #n a3 addq, then, 4 #n a2 addq, a3 a2 cmp, eq until,
a3 i' eosptr move,
then,
0 #n d4 moveq, ( no blanks now need to be added either end )
then, 0 #n d5 moveq, ( in either case, no blanks on left )
then,
then,
then,
then,
rtn #n a1 -4 )d .b cmpi, eq ( now remove cr on right if unselected )
if, a1 -3 )d d1 .b move, $inv #n d1 .b and, eq
if, 20 #n a1 -4 )d .b move, then,
else, ( de-underline trailing blanks ) a1 a2 move,
begin, a2 -4 )d d1 .b move, 20 #n d1 .b cmp, ne
if, markbl #n d1 .b cmp, eq while, then,
$uln ff xor #n a2 -3 )d .b andi, 4 #n a2 subq,
again,
then,
d5 .b tst, ne ( must move some text to right )
if, a1 a4 move, d5 d3 move, 1 #n d3 .b addq, fe #n d3 .b and,
d3 d3 .w add, d3 a4 add,
d3 i' eosptr add, d3 i' bosptr add,
a4 a2 move, ( a4=a2=subsequent right edge ) lbuff 8 + #n a3 move,
begin, a1 -) a4 -) move, a3 a1 cmp, eq until,
1 #n d5 .b lsr, cs
if, a4 -) .w clr, markbl 100 * $half + #n a4 -) .w move, then,
begin, 1 #n d5 .b subq, pl
while, a4 -) .w clr, markbl 100 * #n a4 -) .w move, again,
a2 a1 move, ( a1=place for trailing right blanks )
then, ( spaces can now go in on right side )
a1 d1 move, lbuff #n d1 sub, d1 i' lbufwidth move, ( save last posit )
&horiz 4 + #n d5 .w move,
a0 d5 .w sub, #wide d5 .b sub, #left d5 .b sub,
d5 d4 .b add, ( fills out to screen boundary )
1 #n d4 .b lsr, cs
if, markbl 100 * $half + #n a1 )+ .w move, a1 )+ .w clr, then,
begin, 1 #n d4 .b subq, pl
while, markbl 100 * #n a1 )+ .w move, a1 )+ .w clr, again,
a1 -7 )d d0 .b move, $half #n d0 .b and, ne
if, 4 #n a1 subq,
else, a1 -3 )d d0 .b move, $half #n d0 .b and, eq
if, rtn #n a1 -8 )d .b cmpi, eq
if, 4 #n a1 subq,
else, $half #n a1 -7 )d .b ori, $half #n a1 -3 )d .b ori,
then,
then,
then,
lbuff a1 )+ .b move, $end #n a1 )+ .b move, ( signal disp line ends )
a1 )+ .w clr,
sp )+ a5 move, sp )+ a4 move, sp )+ a3 move, sp )+ a2 move,
sp )+ d7 move, sp )+ d6 move, sp )+ d5 move, sp )+ d4 move,
next;
: intext? ( addr -- f | true if address is in the current range of text )
dup bor gap 1- inrange swap beot eor inrange or ;
: refresh ( 8:13:12:45 )
norefresh if exit then ( if we shouldn't refresh, then done )
lastseen 1+ firstseen
do i update?
if i loadline #spr c@ ( 0=real line of text, 1=no display )
if firstseen i = if 0 halfdisp then #spr c@ 1 > i lastseen < and
if i 1+ firstseen - halfdisp then
else lastseen i =
if i firstseen - halfdisp else build i firstseen - disp then
then
then
loop ;
code prevmatch sp )+ d1 move, sp )+ a0 move,
begin, a0 -) d0 .b move, &skip #n d0 .b cmp, eq
if, tc' ^sk< jsr, then, d1 d0 .b cmp, eq
until, a0 sp -) move, next;
code nextmatch sp )+ d1 move, sp )+ a0 move,
begin, a0 )+ d0 .b move, &skip #n d0 .b cmp, eq
if, tc' ^sk> jsr, then, d1 d0 .b cmp, eq
until, 1 #n a0 subq, a0 sp -) move, next;
( addr1 addr2 --- ,mark ivls corresponding to text range as invalid )
code killivls sp )+ d0 move, ( char after) sp )+ d1 move, ( first char )
esize #n d2 moveq, d1 d3 move, i' text d1 sub, isize #n d1 .w divu,
d2 d1 .w mulu, eq if, d2 d1 move, then, ( never take ivl 0 )
#itbl %wr + #n d1 add, d1 a0 move, ( starting ivl address )
a0 ) d1 move, ( first text addr with stripped hi bit) d1 d1 add, 1 #n d1 lsr,
d3 d1 cmp, cs if, d2 a0 add, then, ( first ivl addr not in range )
d0 d3 move, ( save endpoint of text area ) i' text d0 sub,
isize #n d0 .w divu, d2 d0 .w mulu,
#itbl %wr + #n d0 add, d0 a1 move, ( last ivl addr ) a1 ) d0 move,
d0 d0 add, 1 #n d0 lsr, d3 d0 cmp, nc if, d2 a1 sub, then, ( prev ivl )
-1 #n d3 moveq,
begin, a0 a1 cmp, nc while, d3 a0 ) move, d2 a0 add, again, next;
( addr1 addr2 --- ,mark all ivls in range as potentially valid )
code hideivls sp )+ d0 move, ( char after) sp )+ d1 move, ( first char )
esize #n d2 moveq, d1 d3 move, i' text d1 sub, isize #n d1 .w divu,
d2 d1 .w mulu, eq if, d2 d1 move, then, ( never take ivl 0 )
#itbl %wr + #n d1 add, d1 a0 move, ( starting ivl address )
a0 ) d1 move, ( first text addr with stripped hi bit) d1 d1 add, 1 #n d1 lsr,
d3 d1 cmp, cs if, d2 a0 add, then, ( first ivl addr not in range )
d0 d3 move, ( save endpoint of text area ) i' text d0 sub,
isize #n d0 .w divu, d2 d0 .w mulu,
#itbl %wr + #n d0 add, d0 a1 move, ( last ivl addr ) a1 ) d0 move,
d0 d0 add, 1 #n d0 lsr, d3 d0 cmp, nc if, d2 a1 sub, then, ( prev ivl )
-80 #n d3 moveq,
begin, a0 a1 cmp, nc while, d3 a0 ) .b or, d2 a0 add, again, next;
( --- 0 -or- addr -1 ,false, or ivl table addr of first uncomputed ivl )
code badivl #itbl %wr + #n a0 move, i' endtextivl d0 move,
i' gapivl d1 move, %wr #n d1 addq, 0 #n d2 moveq, esize #n d3 moveq,
begin, a0 d1 cmp, eq ( if at gap, skip past beot )
if, i' beotivl a0 move, d3 a0 add, %wr #n a0 addq, then,
a0 ) .b tst, mi ( now look for uncalculated ivl )
if, a0 d0 cmp, cs if, leave, then, ( went too far )
a0 d2 move, #itbl #n d2 sub, ( convert to text interval addr )
d3 d2 .w divu, isize #n d2 .w mulu,
i' text d2 add, leave,
then, d3 a0 add, a0 d0 cmp, cs
until, d2 sp -) move, ne if, -1 #n d3 moveq, d3 sp -) move, then,
next;
( addr --- ,converts char address into state at nearest interval bndry )
code knownplace sp )+ d0 move, d0 d1 move, esize #n d2 moveq,
i' text d0 sub, ( rela addr ) isize #n d0 .w divu,
( interval # ) d2 d0 .w mulu,
#itbl %wr + esize + #n d0 add, ( locate in interval table ) d0 a0 move,
begin, d2 a0 sub, a0 ) d1 cmp, nc until, ( first lower addr)
%wr #n a0 subq, #ctrl #n a1 move,
esize 4 / 1- #n d0 moveq, begin, a0 )+ a1 )+ move, d0 nt -until,
( set current state from nearest interval in table ) next;
( addr --- addr1 ,returns address of nearest ivl table entry )
code nearivl sp )+ d0 move, i' text d0 sub, ( rela addr )
isize #n d0 .w divu, ( interval # ) esize #n d0 .w mulu,
#itbl #n d0 add, ( locate in interval table ) d0 sp -) move, next;
( addr --- addr1 , returns address of nearest valid ivl table entry )
code goodivl sp )+ d0 move, d0 d1 move, esize #n d2 moveq,
i' text d0 sub, ( rela addr ) isize #n d0 .w divu,
( interval # ) d2 d0 .w mulu,
#itbl %wr + esize + #n d0 add, ( locate in interval table ) d0 a0 move,
begin, d2 a0 sub, a0 ) d1 cmp, nc until, ( first lower or = addr)
%wr #n a0 subq, a0 sp -) move, next;
( line --- ,converts line number into state at nearest interval )
code line>ivl sp )+ d0 move, i' beotivl a0 move, esize #n d2 moveq,
i' endtextivl d1 move, esize #n d1 sub, ( d1 ivl before endtext )
a0 %wr )d .b tst, mi
if, d1 a0 cmp, ne ( d1 contains last interval )
if, d2 a0 add, then,
a0 %wr )d .b tst,
then, mi
if, d1 a0 move, ( d1 still contains last interval )
else, a0 %ln )d d0 cmp, cs
( if beotline > line look to left of gap, else end of ivl table )
if, i' gapivl a0 move, else, d1 a0 move, then,
then, d2 a0 add, ( aim just beyond, then step back )
begin, begin, d2 a0 sub, a0 %wr )d .b tst, pl until,
a0 %ln )d d0 cmp, nc
until, esize 4 / 1- #n d0 moveq, #ctrl #n a1 move,
begin, a0 )+ a1 )+ move, d0 nt -until,
( set current state from nearest line in interval table ) next;
code nearinterval sp ) d0 move, i' text d0 sub,
isize negate #n d0 andi, i' text d0 add, d0 sp ) move, next;
( tlh 5/24:12:00 )
code putivl ( --- flag ,true if all ivls done ) sp -) clr,
#wr d1 move, d1 d2 move, i' text d2 sub, ( displacement into text )
i' endtext d3 move, i' text d3 sub, 1f #n d3 sub, ( text size + 1 )
d3 d2 cmp, nc if, next, then, ( not > eot )
isize #n d2 .w divu, eq if, next, then, ( avoid ivl 0 )
esize #n d2 .w mulu, #itbl #n d2 add, ( location in ivl table )
d2 a0 move, #ctrl #n a1 move, ( prepare to copy in new format values )
a0 %lnl )d d3 .w move, a1 %lnl )d d3 .w cmp, eq ( same posit in page )
lif, a0 %wr )d d3 move, 80000000 #n d3 add, a1 %wr )d d3 cmp, eq
lif, i' markpoint d3 cmp, nc ( must be beyond previous completion attempts)
lif, ( hidden, reconstitute rest offset for ln, pgl, pg ) d4 sp -) move,
a1 %ln )d d0 move, a0 %ln )d d0 sub, ( d0:offset for line #'s )
a1 %pg )d d1 move, a0 %pg )d d1 sub, ( d1:offset for page #'s )
a1 %pgl )d d2 move, a0 %pgl )d d2 sub, ( d2:offset local pgs )
a0 %pg )d d3 move, a0 %pgl )d d3 sub, ( d3:old diff pg/pgl )
begin, a0 %pg )d d4 move, a0 %pgl )d d4 sub, ( diff changes after ds )
d0 a0 %ln )d add, d1 a0 %pg )d add, ff #n a0 %wr )d .b cmpi, ne
if, 7f #n a0 %wr )d .b andi, then, d4 d3 .w cmp, eq ( pgls go up too )
while, d2 a0 %pgl )d add, esize #n a0 add, i' endtextivl a0 cmp, nc
until, ( finish off table, old pgls now all correct )
begin, esize #n a0 add, i' endtextivl a0 cmp, cs
while, d0 a0 %ln )d add, d1 a0 %pg )d add,
ff #n a0 %wr )d .b cmpi, ne if, 7f #n a0 %wr )d .b andi, then,
again, sp )+ d4 move, 1 #n sp ) subq,
i' markpoint clr, next, ( signals ivls complete )
then,
then, ( otherwise, emplace new data into one ivl only )
then, esize 4 / 1- #n d1 moveq, a1 %wr )d d0 move,
i' markpoint d0 cmp, nc if, d0 i' markpoint move, then,
i' eot d0 cmp, nc if, i' markpoint clr, then,
begin, a1 )+ a0 )+ move, d1 nt -until, next;
( addr --- ,complete ivl table thru nearest interval to text addr )
: wrapthru local close local limit nearinterval limit to limit knownplace
begin #wr @ nearinterval isize + 1- close to close limit <
while close wraplim to wrap putivl
until ;
( will try to fix one bad interval in table, except gapivl or beotivl )
: fixivl badivl if wrapthru then ;
( addr --- ,find state at beginning of line on which char resides )
: findchar dup dup wrapthru wraplim to knownplace
( wrap until one line too far... ) wrap prevwrap ;
( tlh 6/2:16:51 )
( line --- ,converts line number into state at that line )
: findline dup line>ivl #ln @ - ?dup
if 0 do wrap putivl drop loop then ; ( count off lines from nearest interval )
( recompute and mark for update all of the window array )
: rewindow preset topline findline
lastline 1+ 0 do i storeline putivl drop wrap i update! loop ;
( --- addr -1 -or- 0 ,true & addr in table of next valid ivl or false )
code nextivl sp )+ a0 move, i' endtextivl d0 move,
%wr #n a0 add,
begin, esize #n a0 add, a0 d0 cmp, cs
if, 0 #n d0 moveq, d0 sp -) move, next, then, a0 ) .b tst, pl
until,
%wr #n a0 sub, a0 sp -) move, -1 #n d0 moveq, d0 sp -) move, next;
( --- addr -1 -or- 0 ,true & addr in table of prev valid ivl or false )
code previvl sp )+ a0 move, #itbl #n d0 move,
%wr #n a0 add, ( examine wrap addresses for >0, valid )
begin, esize #n a0 sub, a0 d0 cmp, nc
if, 0 #n d0 moveq, d0 sp -) move, next, then, a0 ) .b tst, pl
until,
%wr #n a0 sub, a0 sp -) move, -1 #n d0 moveq, d0 sp -) move, next;
( tlh 5/2:21:45 )
( addr --- ,move control to beginning character in page following addr )
: nextpage local place dup findchar dup goodivl place to
eot < not if exit then ( don't go past last page )
begin place nextivl ( stop when no more valid ivls )
while %pg + @ #pg @ = ( stop when next ivl has diff page # )
while place nextivl drop place to ( not found, keep going )
place #ctrl esize move ( implicit or real page since here )
again begin #lnl w@ while wrap again ; ( stop at beginning of page )
( tlh 2/24:16:50 )
( addr --- ,move control to beginning character in page preceeding addr)
: prevpage local nearpage local place
dup findchar dup goodivl place to bot nextchar < if exit then ( if bot )
#pg @ nearpage to ( find ivl for previous page to this )
begin nearpage place %pg + @ = ( ivl still applies to nearpage )
while place previvl drop place to
again ( now get state, wrap until page match ) place #ctrl esize move
begin wrap nearpage #pg @ = until ;
( tlh 5/2:21:48 )
( addr --- addr' ,move control to next document break beyond addr )
: nextdoc local place nextchar dup c@ ds = if exit then
dup findchar dup goodivl place to
eot < not if eot prevchar exit then ( not past last page )
begin place nextivl ( stop at end of table )
while dup %pg + @ swap %pgl + @ - #pg @ #pgl @ - = ( no doc )
while place nextivl drop place to
place #ctrl esize move ( get first document break )
again begin #wr @ c@ ds <> while wrap again #wr @ ;
( addr --- addr' ,move control to nearest previous document break )
: prevdoc local place dup goodivl place to dup findchar
bot nextchar < if bot exit then ( not before first page )
begin place previvl ( stop at start of table )
while dup %pg + @ swap %pgl + @ - #pg @ #pgl @ - = ( no doc )
while place previvl drop place to
place #ctrl esize move
again #wr @ ds prevmatch findchar #wr @ ;
( n --- flag ,true if screen line n is different from current state )
code differs? -1 #n d1 moveq, sp ) d0 move, esize #n d0 .w mulu,
#wtable #n d0 add, d0 a0 move, ( a0=>line n state in table )
#ctrl #n a1 move, ( =>current control state )
a1 )+ a0 )+ cmpm, eq ( local/global page #s )
if, a1 )+ a0 )+ cmpm, eq
if, a1 )+ a0 )+ cmpm, eq
if, a1 )+ a0 )+ cmpm, eq
if, a1 )+ a0 )+ cmpm, eq
if, a1 )+ a0 )+ cmpm, eq
if, a1 )+ a0 )+ cmpm, eq
if, a1 )+ a0 )+ cmpm, eq
if, a1 )+ a0 )+ cmpm, eq ( wrap address )
if, a1 )+ a0 )+ cmpm, eq ( local/global line #s )
if, a1 )+ a0 )+ cmpm, eq ( formats ) if, 0 #n d1 moveq, then,
then,
then,
then,
then,
then,
then,
then,
then,
then,
then, d1 sp ) move, next;
( ln1 --- ln2 ,find screen line number of last real line of text )
code stepback sp ) d0 move, d0 d1 move, esize #n d1 .w mulu,
#wtable %wr + #n d1 add, d1 a0 move, ( wrap addr for line ln1 )
a0 ) d1 move, ( use this addr to find first smaller addr in table )
begin, 1 #n d0 .b subq, mi if, sp ) clr, next, then, ( reached top line )
esize #n a0 sub, a0 ) d1 cmp, ne
until, d0 sp ) move, next;
( ln1 --- ln2 ,find screen line number of next real line of text )
code stepahead sp ) d0 move, d0 d1 move, esize #n d1 .w mulu,
#wtable %wr + esize + #n d1 add, d1 a0 move, ( wrap addr line ln1 + 1 )
a0 ) d1 move, ( use this addr to find first larger addr in table )
begin, 1 #n d0 .b addq, lastline #n d0 .b cmp, eq
if, d0 sp ) move, next, then, esize #n a0 add, a0 ) d1 cmp, ne
until, d0 sp ) move, next;
( tlh 6/16:14:54 )
code adjust sp )+ d0 move, ( d0=offset to add to each pointer )
sp )+ d2 move, ( d2=hi ) sp )+ d1 move, ( d1=lo )
d4 sp -) move, d5 sp -) move, d6 sp -) move, d7 sp -) move,
i' op d1 cmp, le if, i' op d2 cmp, gt if, d0 i' op add, then, then,
i' pop d1 cmp, le if, i' pop d2 cmp, gt if, d0 i' pop add, then, then,
i' p d1 cmp, le if, i' p d2 cmp, gt if, d0 i' p add, then, then,
i' bot d1 cmp, le if, i' bot d2 cmp, gt if, d0 i' bot add, then, then,
i' bor d1 cmp, le if, i' bor d2 cmp, gt if, d0 i' bor add, then, then,
i' eor d1 cmp, le if, i' eor d2 cmp, gt if, d0 i' eor add, then, then,
i' eot d1 cmp, le if, i' eot d2 cmp, gt if, d0 i' eot add, then, then,
i' bos d1 cmp, le if, i' bos d2 cmp, gt if, d0 i' bos add, then, then,
i' eos d1 cmp, le if, i' eos d2 cmp, gt if, d0 i' eos add, then, then,
i' gap d1 cmp, le if, i' gap d2 cmp, gt if, d0 i' gap add, then, then,
i' bou d1 cmp, le if, i' bou d2 cmp, gt if, d0 i' bou add, then, then,
i' beot d1 cmp, le if, i' beot d2 cmp, gt if, d0 i' beot add, then, then,
i' cpos d1 cmp, le if, i' cpos d2 cmp, gt if, d0 i' cpos add, then, then,
i' extbos d1 cmp, le if, i' extbos d2 cmp, gt if, d0 i' extbos add, then, then,
i' mover d1 cmp, le if, i' mover d2 cmp, gt if, d0 i' mover add, then, then,
i' parsed d1 cmp, le if, i' parsed d2 cmp, gt if, d0 i' parsed add, then, then,
i' astring d1 cmp, le if, i' astring d2 cmp, gt if, d0 i' astring add, then,
then,
i' scanner d1 cmp, le if, i' scanner d2 cmp, gt if, d0 i' scanner add, then,
then,
i' oldpocket d1 cmp, le if, i' oldpocket d2 cmp, gt if, d0 i' oldpocket add,
then, then,
i' savebos d1 cmp, le if, i' savebos d2 cmp, gt if, d0 i' savebos add, then,
then,
i' oldop d1 cmp, le if, i' oldop d2 cmp, gt if, d0 i' oldop add, then, then,
i' oldop2 d1 cmp, le if, i' oldop2 d2 cmp, gt if, d0 i' oldop2 add, then, then,
i' oldpop d1 cmp, le if, i' oldpop d2 cmp, gt if, d0 i' oldpop add, then, then,
i' oldpop2 d1 cmp, le if, i' oldpop2 d2 cmp, gt if, d0 i' oldpop2 add, then,
then,
i' oldbos d1 cmp, le if, i' oldbos d2 cmp, gt if, d0 i' oldbos add, then, then,
i' oldbos2 d1 cmp, le if, i' oldbos2 d2 cmp, gt if, d0 i' oldbos2 add, then,
then,
i' oldeos d1 cmp, le if, i' oldeos d2 cmp, gt if, d0 i' oldeos add, then, then,
i' oldeos2 d1 cmp, le if, i' oldeos2 d2 cmp, gt if, d0 i' oldeos2 add, then,
then,
#wr d1 cmp, le if, #wr d2 cmp, gt if, d0 #wr add, then, then,
#nextwr d1 cmp, le if, #nextwr d2 cmp, gt if, d0 #nextwr add, then, then,
#wtable #n d4 move, ( thru window table end to start)
#wtable %wr + esize lastline * + #n a0 move, esize #n d3 moveq,
begin, a0 ) d5 move, d5 d1 cmp, le ( d5=addr of line in window table )
if, d5 d2 cmp, gt if, d0 a0 ) add, then, then, d3 a0 sub, d4 a0 cmp, cs
until, ( corrected all window table addresses in the range )
#itbl #n d4 move, ( thru interval table end to start )
i' endtextivl a0 move, %wr esize - #n a0 add,
begin, a0 ) d5 move, d5 d1 cmp, le
if, d5 d2 cmp, gt if, d0 a0 ) add, then, then, d3 a0 sub, d4 a0 cmp, cs
until, sp )+ d7 move, sp )+ d6 move, sp )+ d5 move, sp )+ d4 move,
next;
: blink ( -- )
cursorblock 0=
if cursorstate
if offtime dirtytext? not if 2 shr then
bticks! <cursoroff>
else ontime dirtytext? not if 2 shr then
bticks! <cursoron>
then
then ;
: cursoroff ( -- | forces the cursor off and leave deactivated )
cursorblock on ( deactivate cursor )
cursorstate ( if currently on )
if <cursoroff> then ; ( then turn off )
: cursoron ( -- | force cursor on and reactivate )
cursor? ( if we are allowed to see the cursor )
if cursorblock on ( deactivate cursor, just to make sure )
cursorstate 0= ( only if currently off )
if <cursoron> then ( should be off, so turns cursor on )
cursorblock off ( and reactivates cursor )
then ;
( tlh 4/7:14:35 )
code seenlines i' lastseen d0 move, i' firstseen d0 sub, 1 #n d0 addq,
d0 sp -) move, next;
( tlh 4/5:20:14 )
code page? ( char -- flag, true if char is a page-like character )
( dup pb = swap ds = or ; )
sp )+ d0 move, ds 2+ #n d0 .b sub, 2 #n d0 .b addq, d0 d0 subx,
d0 sp -) move, next;
( tlh 4/5:20:17 )
code break? ( char -- flag, true if char causes a new paragraph )
( dup page? swap rtn = or ; )
sp )+ d0 move, ds 3 + #n d0 .b sub, 3 #n d0 .b addq, d0 d0 subx,
d0 sp -) move, next;
( tlh 4/5:20:18 )
code getwidth ( ptr into lbuff -- 1 or 2 ,width in .5 chrs of char in lbuff )
( 1+ c@ $half and 0= negate 1+ ; ) 1 #n d0 moveq,
sp )+ a0 move, smallbit #n a0 1 )d .b btst, eq if, 2 #n d0 moveq, then,
d0 sp -) move, next;
( tlh 5/12:12:20 )
: cursorline ( -- -1,0,1 real lines from here)
cpos inwindow ( see if cursor is properly in window )
if loadline else syserror error abort then ( if not, it is a no-no )
cstate 0< if 0 exit then ( if a split cursor, then always same line )
cstate 0= if ( if cursor is narrow )
cpos c@ page? ( and on a page )
cpos prevchar c@ break? not and ( prev isn't break, then prev line)
else ( if cursor is wide )
cpos c@ break? negate ( and on break ,cursor on next line )
then ;
: real? ( char -- flag | true if char from lbuff is "real" )
dup 20 df inrange swap 0b 0d inrange or ;
code findwidth 0 #n d0 moveq, sp )+ a0 move, lbuff #n a1 move,
begin, a1 )+ d1 .w move, $half #n d1 .b and, eq
if, 1 #n d0 .w addq, then, 1 #n d0 .w addq, 2 #n a1 addq, a0 a1 cmp, nc
until, d0 sp -) move, next;
( tlh 12/16:17:44 )
: indentsize #indent c@ overscanwidth + #just c@ 1 = if #iwide c@ 2- + then
#just c@ 2 = if #iwide c@ 2/ 1- + then cx to 1 cwidth to ;
( tlh 6/24:12:28 )
: findsplit ( -- | sets cx and cy for cursor, leaves state for line with cy )
local lb ( local index into lbuff ) local ad ( local pointer into text )
cpos inwindow 0= ( if cpos is not in the window )
if syserror error abort then ( then something is very wrong )
dup firstseen - cy to ( save the line in cy )
loadline build ( and build up the line found )
cpos c@ page? ( if on a page char )
if indentsize
else ( otherwise, on a normal character )
bosptr dup findwidth cx to
getwidth 1- cwidth to ( and set width for last char positioned )
then ;
( tlh 6/24:14:21 )
: findwide ( -- | sets cx and cy for cursor )
cursorline ( if not 0 then must be start of next line )
if cpos inwindow if stepahead then ( and go to next line on screen )
dup firstseen - cy to ( save as cursor y position )
loadline build ( build up that line )
lbuff 0c + c@ page? ( if a page )
if indentsize
else eosptr dup findwidth cx to getwidth 1- cwidth to
then
else ( on same line, so look for cpos )
cpos inwindow 0= if firstseen then ( ::: )
dup firstseen - cy to ( set screen half-line )
loadline build ( to find cx position )
eos #nextwr @ < ( see if eos is off the end of the line )
if eosptr ( if not, use the pointer into lbuff )
dup findwidth cx to ( and find its width )
getwidth 1- cwidth to ( find width of next char on display )
else lbufwidth lbuff + findwidth cx to ( blink off end of line )
1 cwidth to ( with always a wide cursor )
then
then ;
( tlh 6/9:18:53 )
: findnarrow ( -- | sets cx and cy for cursor )
cursorline ( if not 0, then must be on previous line )
if cpos inwindow 0= if firstseen then ( :::)
stepback ( step back to previous line )
dup firstseen - cy to ( set cursor line clipped )
cy 0< if drop findsplit exit then ( if cursor is off screen )
loadline build ( and build that up )
lbufwidth lbuff + dup findwidth cx to ( blink past last char )
1+ c@ $half and if 0 else 1 then cwidth to ( read size from lbuff )
else findsplit ( if not on break, use findsplit )
then ;
( tlh 4/6:17:37 )
( addr1 addr2 --- 0 -or- addr ,start/end addrs are last chars in strings)
code <search>> sp )+ d0 move, sp ) a0 move, ( d0 end of range)
i' pattern a1 move, 0 #n d2 moveq,
i' patlen d3 move, 1 #n d3 .b subq, mi if, sp ) clr, next, then, ( bad patt)
a0 d0 sub, lt if, sp ) clr, next, then, ( bad range, fails )
(regs a2 a3 a4 d4 d5 to) sp -) movem, 0 #n d4 moveq,
0ff #n d0 .w divu, d0 d1 move,
d1 .w clr, d1 swap, d1 .b not, ( d0=255-byte segments, d1=offset in seg)
a1 d3 add, ( d3:pts to last char in fixed pattern ) a1 d5 move, ( d5:patt)
ptable #n a1 move, ( a1: predigested search advances for all chars )
i' maptable a3 move, ( a3:table of character match equivalences )
d1 a0 sub, ( preset for match search )
begin, ( working thru 255-byte sections )
begin, ( testing match candidates )
begin, a0 d1 0 xw)d d2 .b move, a1 d2 0 xw)d d1 .b add, nc
while, a0 d1 0 xw)d d2 .b move, a1 d2 0 xw)d d1 .b add, cs
until, ( end of section, or match candidate found )
a1 d2 0 xw)d .b tst, mi ( means ff, try match )
lwhile, a0 d1 1 xw)d a2 lea, ( a2: moves right to left back over string )
d3 a4 move, ( a4: moves left across fixed pattern )
begin, a4 d5 cmp, eq ( match succeeds )
if, a2 d0 move, (regs a2 a3 a4 d4 d5 from) sp )+ movem,
d0 sp ) move, next,
then, a4 -) d4 .b move, ( d4: next char from fixed string )
begin, a2 -) d2 .b move, &lastacc 1+ #n d2 .b cmp, nc
while, &skip #n d2 .b cmp, eq
if, a0 a2 exg, tc' ^sk< jsr, a2 a0 exg, then,
again, ( d2: real or accent character from text )
begin, d4 d2 .b cmp, ne ( accent in patt must be matched by same )
while, a3 d4 0 xw)d d4 .b move, eq ( end of match chain reached )
if, &firstacc #n d2 .b cmp, nc ( non-match, but accents do not fail )
if, 1 #n a4 addq, 0 #n d2 moveq, then, ( will fall thru at next cmp)
else, d4 d4 .b cmp, ( to stay in char compare loop )
then, ne ( exit when char compare fails )
until, ne ( exit when string compare fails )
until, 2 #n d1 .b addq, cs ( effectively increments text position by 1 )
until, a0 0ff )d a0 lea, 1 #n d1 .b addq, d0 nt ( no more 255-byte segs )
-until, (regs a2 a3 a4 d4 d5 from) sp )+ movem, sp ) clr, next;
( tlh 4/3:17:22 )
( addr1 addr2 --- 0 -or- addr ,start/end addrs are last chars in strings)
code <search<> sp )+ a0 move, sp ) d0 move,
1 #n a0 addq, ( a0 beyond range)
i' pattern a1 move, 0 #n d2 moveq,
i' patlen d3 move, 1 #n d3 .b subq, mi if, sp -) clr, next, then,
1 #n a0 subq, a0 d0 sub, gt if, sp ) clr, next, then, ( range fails )
(regs a2 a3 a4 d4 d5 to) sp -) movem, 0 #n d4 moveq,
d0 neg, 0ff #n d0 .w divu, d0 d1 move, 1 #n a1 addq,
d1 .w clr, d1 swap, ( d0=255-byte segments, d1=offset in seg)
a1 d3 add, ( d3:pts past fixed pattern ) a1 d5 move, ( d5:patt+1 )
ptable #n a1 move, ( a1: skip values for all chars )
i' maptable a3 move, ( a3:table of character match equivalences )
d1 a0 sub, ( preset for match search )
begin, ( working thru 255-byte sections )
begin, ( testing match candidates )
begin, a0 d1 0 xw)d d2 .b move, a1 d2 0 xw)d d1 .b sub, nc
while, a0 d1 0 xw)d d2 .b move, a1 d2 0 xw)d d1 .b sub, cs
until, ( end of section, or match candidate found )
a1 d2 0 xw)d .b tst, mi ( means ff, try match )
while, a0 d1 0 xw)d a2 lea, ( a2: moves to right from 2nd string char )
d5 a4 move, ( a4: moves right across fixed pattern )
begin, a4 d3 cmp, eq ( match succeeds )
if, (regs a2 a3 a4 d4 d5 from) sp )+ movem, a0 d1 -1 xw)d a0 lea,
a0 sp ) move, next,
then, a4 )+ d4 .b move, ( d4: next char from fixed string )
begin, a2 )+ d2 .b move, &lastacc 1+ #n d2 .b cmp, nc
while, &skip #n d2 .b cmp, eq
if, a2 a0 exg, tc' ^sk> jsr, a0 a2 exg, then,
again, ( d2: real or accent character from text )
begin, d4 d2 .b cmp, ne ( accent in patt must be matched by same )
while, a3 d4 0 xw)d d4 .b move, eq ( end of match chain reached )
if, &firstacc #n d2 .b cmp, nc ( non-match, but accents do not fail )
if, 1 #n a4 subq, 0 #n d2 moveq, then, ( will fall thru at next cmp)
else, d4 d4 .b cmp, ( to stay in char compare loop )
then, ne ( exit when char compare fails )
until, ne ( exit when string compare fails )
until, 2 #n d1 .b subq, cs ( effectively decrements text position by 1 )
until, a0 -ff )d a0 lea, 1 #n d1 .b subq, d0 nt ( no more 255-byte segs )
-until, (regs a2 a3 a4 d4 d5 from) sp )+ movem, sp ) clr, next;
( tlh 6/28:16:57 )
: pbpat
patlen 0= if 0 exit then
0 patlen pattern + pattern do i c@ pb <> + loop 0= ;
( tlh 6/28:17:22 )
: search< ( addr1 addr2 -- 0 or addr ) local rt local lt rt to lt to
lt rt > patlen 0= or if 0 exit then ( not ascending, or no patt )
patlen 1 = pattern c@ pb = and ( if a single page, do special )
if rt c@ page? ( stop on pb )
if rt ( discard beginning address )
else rt prevpage #wr @ dup prevchar c@ page? if prevchar then ( real pb )
then
else lt rt <search<> dup 0=
if pbpat if drop rt eor prevchar = if eor prevchar else bor then then then
then ;
( tlh 6/28:17:22 )
: search> ( addr1 addr2 -- 0 or addr ) local rt local lt rt to lt to
lt rt >
if pbpat lt eor patlen 1- advanceptr < and if eor prevchar exit then then
lt rt > patlen 0= or if 0 exit then ( not ascending or nopat )
patlen 1 = pattern c@ pb = and ( if a single page, do special )
if lt nextpage #wr @ ( get next page )
dup prevchar c@ page? if prevchar then ( if real page point to it )
else lt rt <search>> dup 0=
if pbpat
if drop bor patlen 1- advanceptr lt = if bor else eor prevchar then then
then
then dup rt > if drop 0 then ;
( tlh 4/5:21:52 )
code bare? ( char -- flag | true if char is a bare accent )
( b0 bf inrange ; )
sp ) d0 move, c0 #n d0 .b sub, 10 #n d0 .b add, d0 d0 subx,
d0 sp ) move, next;
( tlh 4/5:21:52 )
code accentable? ( char -- flag | true if char is able to take an accent )
( 20 af inrange ; ) ( current definition is that any char is accentable )
sp ) d0 move, b0 #n d0 .b sub, 90 #n d0 .b add, d0 d0 subx,
d0 sp ) move, next;
: pattadd ( character -- | adds char to existing pattern )
local place
begin
pattern patlen + place to
dup if dup ff > ( if a double character )
if patlen 1+ patternsize < ( is there enough room? )
if place w! ( if so, add the character )
2 patlen +to ( and bump the length )
else drop then ( else get rid of the offending char )
else patlen patternsize < ( is there enough room? )
if place c! ( the add to pattern )
patlen ( is there any pattern yet? )
if place 1- c@ bare? ( was previous char a bare accent? )
place c@ accentable? and ( and this one not accent? )
if place 1- c@ place c@ ( we need to exchange places)
place 1- c! 0f and c0 or place c! ( make real accent )
then
then
1 patlen +to ( and increase count )
else drop ( wasn't enough room so ignore char)
then
then
then
<?k> while ( if there is another character )
?lex ?rex or while ( and a lex key must still be down )
?kval ff00 and ff00 <> while ( can't about to be a special key )
?kval 00ff and erase < while ( nor erase or undo key )
<key> stripshifts ( then get the key )
again ;
: pattdel ( -- | removes char from existing pattern )
patlen ( if any characters in the pattern )
if -1 patlen +to then ; ( then remove it )
( d0 scratch a0 pattern address
d1 direction [scratch] a1 pattern table
d2 length a2 match table
d3 scratch )
code buildtable ( addr len direction -- ) ( tlh 4/03:17:25 )
sp )+ d1 move, ( get the direction the search will take )
sp )+ d2 move, ( the length of the string )
sp )+ a0 move, ( and the starting address of the string )
eq if, next, then, ( < 1 chars does not need table built )
ptable #n a1 move, a2 sp -) move, ( a1=pattern table used in search)
i' maptable a2 move, ( a2 = chained character equivalences )
d2 d3 move, 8 #n d3 .w rol, d2 d3 .b move, d3 d2 move, d2 swap,
d3 d2 .w move, ( d2 = 4 copies of length byte )
&firstacc 4 / 1- #n d3 moveq, ( all chars value = len )
begin, d2 a1 )+ move, d3 nt -until, 01010101 #n d0 move,
100 &firstacc - 4 / 1- #n d3 moveq, ( skip special chars by len = 1 )
begin, d0 a1 )+ move, d3 nt -until, 1 #n d2 .b subq, ff #n d2 and,
ptable #n a1 move, 0 #n d0 moveq,
d1 tst, ne ( -1 = search right )
if, d2 .b tst,
begin, eq if, -1 #n d2 moveq, then, ( signal char = ff )
a0 )+ d0 .b move, &firstacc #n d0 .b cmp, cs
if, begin, d2 a1 d0 0 xw)d .b move, a2 d0 0 xw)d d0 .b move, eq until,
else, d2 .b tst, mi if, d2 a1 d0 0 xw)d .b move, then, ( accent at end)
then, ( repeat until chain exhausted ) 1 #n d2 .b subq, mi
until,
else, d2 a0 add, 1 #n a0 addq, ( 0 = setup for search left ) d2 .b tst,
begin, eq if, -1 #n d2 moveq, then,
a0 -) d0 .b move, &firstacc #n d0 .b cmp, cs
if, begin, d2 a1 d0 0 xw)d .b move, a2 d0 0 xw)d d0 .b move, eq until,
then, 1 #n d2 subq, mi
until,
then, sp )+ a2 move, ( restore a2 ) next;
( tlh 4/13:15:21 )
code reverse ( addr count -- | reverse count bytes starting at location addr )
sp )+ d0 move, sp )+ a0 move, ( get arguments )
a0 d0 0 xl)d a1 lea, ( determine far end )
1 #n d0 lsr, ( div by 2, to stop at midpoint )
1 #n d0 lsr, cs ( amortize cycles in the big loop to follow )
if, a0 ) d1 .b move, a1 -) a0 )+ .b move, d1 a1 ) .b move, then,
1 #n d0 lsr, cs
if, a0 ) d1 .b move, a1 -) a0 )+ .b move, d1 a1 ) .b move,
a0 ) d1 .b move, a1 -) a0 )+ .b move, d1 a1 ) .b move,
then, 1 #n d0 subq, pl ( pretest loop )
if, begin, ( loop > 10000 hex )
begin, a0 ) d1 .b move, a1 -) a0 )+ .b move, d1 a1 ) .b move,
a0 ) d1 .b move, a1 -) a0 )+ .b move, d1 a1 ) .b move,
a0 ) d1 .b move, a1 -) a0 )+ .b move, d1 a1 ) .b move,
a0 ) d1 .b move, a1 -) a0 )+ .b move, d1 a1 ) .b move,
d0 nt -until, ( until 64k done )
10000 #n d0 sub, mi until, ( all 64k segs done )
then, next;
( tlh 5/7:7:31 )
( lo hi dist --- ,adjust tables & integer values in range lo,hi by dist )
code realign sp )+ d0 move, ( d0=offset to add to each pointer )
sp )+ d2 move, ( d2=hi ) sp )+ d1 move, ( d1=lo )
d4 sp -) move, d5 sp -) move, d6 sp -) move, d7 sp -) move,
i' op d1 cmp, le if, i' op d2 cmp, gt if, d0 i' op add, then, then,
i' pop d1 cmp, le if, i' pop d2 cmp, gt if, d0 i' pop add, then, then,
i' p d1 cmp, le if, i' p d2 cmp, gt if, d0 i' p add, then, then,
i' bot d1 cmp, le if, i' bot d2 cmp, gt if, d0 i' bot add, then, then,
i' bor d1 cmp, le if, i' bor d2 cmp, gt if, d0 i' bor add, then, then,
i' eor d1 cmp, le if, i' eor d2 cmp, gt if, d0 i' eor add, then, then,
i' eot d1 cmp, le if, i' eot d2 cmp, gt if, d0 i' eot add, then, then,
i' bos d1 cmp, le if, i' bos d2 cmp, gt if, d0 i' bos add, then, then,
i' eos d1 cmp, le if, i' eos d2 cmp, gt if, d0 i' eos add, then, then,
i' gap d1 cmp, le if, i' gap d2 cmp, gt if, d0 i' gap add, then, then,
i' bou d1 cmp, le if, i' bou d2 cmp, gt if, d0 i' bou add, then, then,
i' beot d1 cmp, le if, i' beot d2 cmp, gt if, d0 i' beot add, then, then,
i' cpos d1 cmp, le if, i' cpos d2 cmp, gt if, d0 i' cpos add, then, then,
i' extbos d1 cmp, le if, i' extbos d2 cmp, gt if, d0 i' extbos add, then, then,
i' mover d1 cmp, le if, i' mover d2 cmp, gt if, d0 i' mover add, then, then,
i' parsed d1 cmp, le if, i' parsed d2 cmp, gt if, d0 i' parsed add, then, then,
i' astring d1 cmp, le if, i' astring d2 cmp, gt if, d0 i' astring add, then,
then,
i' scanner d1 cmp, le if, i' scanner d2 cmp, gt if, d0 i' scanner add, then,
then,
i' oldpocket d1 cmp, le if, i' oldpocket d2 cmp, gt if, d0 i' oldpocket add,
then, then,
i' savebos d1 cmp, le if, i' savebos d2 cmp, gt if, d0 i' savebos add, then,
then,
i' oldop d1 cmp, le if, i' oldop d2 cmp, gt if, d0 i' oldop add, then, then,
i' oldop2 d1 cmp, le if, i' oldop2 d2 cmp, gt if, d0 i' oldop2 add, then, then,
i' oldpop d1 cmp, le if, i' oldpop d2 cmp, gt if, d0 i' oldpop add, then, then,
i' oldpop2 d1 cmp, le if, i' oldpop2 d2 cmp, gt if, d0 i' oldpop2 add, then,
then,
i' oldbos d1 cmp, le if, i' oldbos d2 cmp, gt if, d0 i' oldbos add, then, then,
i' oldbos2 d1 cmp, le if, i' oldbos2 d2 cmp, gt if, d0 i' oldbos2 add, then,
then,
i' oldeos d1 cmp, le if, i' oldeos d2 cmp, gt if, d0 i' oldeos add, then, then,
i' oldeos2 d1 cmp, le if, i' oldeos2 d2 cmp, gt if, d0 i' oldeos2 add, then,
then,
#wr d1 cmp, le if, #wr d2 cmp, gt if, d0 #wr add, then, then,
#nextwr d1 cmp, le if, #nextwr d2 cmp, gt if, d0 #nextwr add, then, then,
#wtable #n d4 move, ( thru window table end to start)
#wtable %wr + esize lastline * + #n a0 move, esize #n d3 moveq,
begin, a0 ) d5 move, d5 d1 cmp, le ( d5=addr of line in window table )
if, d5 d2 cmp, gt if, d0 a0 ) add, then, then, d3 a0 sub, d4 a0 cmp, cs
until, ( corrected all window table addresses in the range )
d0 tst, ( see if offset is upward or downward )
i' endtextivl a0 move, %wr esize - #n a0 add, #itbl %wr + #n d4 move,
d0 tst, ( if adding offsets )
mi if, a0 d4 exg, d3 d4 add, d3 a0 add, d3 neg, then, ( reverse direction )
begin, a0 ) d5 move, d5 d1 cmp, le
if, d5 d2 cmp, gt
if, d0 d5 add, ( new addr ) i' text d6 move, isize #n d6 add,
d6 d5 cmp, nc ( not ivl 0 )
if, d5 d6 move, ( save to put in as ivl entry wrap addr )
i' text d5 sub, isize #n d5 .w divu, esize #n d5 .w mulu,
#itbl #n d5 add, d5 a1 move, a0 -8 )d a1 )+ move, a0 -4 )d a1 )+ move,
d6 a1 )+ move, 4 #n a0 add, esize 4 / 4 - #n d7 moveq,
begin, a0 )+ a1 )+ move, d7 nt -until, esize %wr - #n a0 sub,
then, -1 #n a0 ) move, ( blot old ivl addr )
then,
then, d3 a0 sub, d4 a0 cmp, eq ( until we've gone past the last one )
until, sp )+ d7 move, sp )+ d6 move, sp )+ d5 move, sp )+ d4 move,
next;
( tlh 4/11:15:24 )
code ubufsize ( --- ,returns bytes in undo buffers )
i' beot d0 move, 4 #n d0 subq, i' bou d0 sub, d0 sp -) move, next;
( tlh 4/5:21:54 )
code eou ( -- end of undobuffer ) ( beot 4 - ;)
i' beot d0 move, 4 #n d0 subq, d0 sp -) move, next;
( tlh 4/6:17:59 )
code clearundo ( -- ) ( eou bou to undop off ;)
i' beot i' bou move, 4 #n i' bou subq, i' undop clr, next;
: enoughtext ( space -- true | available false )
bou gap - 4 - < dup not if bou gap - 4 - swap then ;
( tlh 7/03:9:42 )
: movegap ( moves gap to align beot with eos. leaves undo buffer intact )
local size local oeos eos oeos to ( bytes to cross gap, old eos )
eos gap beot inrange if exit then ( if nothing to move, we're done )
eos gap < ( stuff from the left side of gap )
if gap eos - size to ( find size of area being moved )
eos gap beot gap - ( prepare to fix pointers )
size enoughtext ( if enough room for move version )
?dup swap drop ubufsize 0= or ( or there isn't an undo buffer )
if bou bou size - ubufsize move ( move the undo buffer down)
eos beot size - size move ( move the text up )
else gap beot over - reverse ( reverse undo buffer in gap )
eos gap over - reverse ( reverse text to be moved )
eos beot over - reverse ( and reverse everything into place )
then realign ( now ptrs actually fixed )
size negate dup bou +to beot +to ( adjust undo buffer and beot )
oeos gap to beot eos to ( and eos )
else eos beot - size to ( gap to be moved to far side of beot )
beot eos gap beot - ( prepare to fix pointers )
size enoughtext ( if enough room for move version )
?dup swap drop ubufsize 0= or ( or no undo buffer )
if beot gap size move ( move the text down to the gap )
bou bou size + ubufsize move ( move the undo buffer up )
else gap beot over - reverse ( reverse undo buffer in the gap )
beot eos over - reverse ( reverse the text to be moved )
gap eos over - reverse ( reverse everything into place )
then realign ( now actually fix pointers )
size bou +to size gap +to ( set up gap )
eos beot to
then preset gap beot killivls ; ( possible debris )
( tlh 5/21:12:05 )
code ?split ( cstate -1 = ;) i' cstate d0 move, 1 #n d0 .b addq,
d0 d0 subx, d0 sp -) move, next;
( tlh 5/21:12:05 )
code ?extended ( cstate 2 = ;) 0 #n d1 moveq,
2 #n i' cstate 3 + .b cmpi, eq if, -1 #n d1 moveq, then, d1 sp -) move, next;
( tlh 5/21:12:05 )
code ?expanded ( cstate 3 = ;) 0 #n d1 moveq,
3 #n i' cstate 3 + .b cmpi, eq if, -1 #n d1 moveq, then, d1 sp -) move, next;
( tlh 5/23:11:21 )
code widecursor? ( cstate 1 = ; ) sp -) clr, 1 #n i' cstate cmpi, eq
if, 1 #n sp ) subq, then, next;
: narrowcursor
eos prevchar bor =
if widecursor
else 0 cstate to eos prevchar cpos to findnarrow
then ;
( tlh 4/5:22:05 )
code narrowcursor? ( cstate 0= ;) i' cstate d0 move, 1 #n d0 subq,
d0 d0 subx, d0 sp -) move, next;
: widecursor
eos eor =
if narrowcursor
else 1 cstate to eos prevchar cpos to findwide
then ;
: extendedcursor widecursor 2 cstate to ;
: splitcursor
-1 cstate to findsplit ;
: resetcursor
cstate 0< if splitcursor
else cstate 0= if narrowcursor
else cstate 1 = if widecursor
else extendedcursor then then then ;
( --- line, returns last displayable line ) ( 5/10:20:49 )
: lastknownline eot knownplace #ln @ #spr c@ + 2- ;
( tlh 4/8:8:05 )
( screen-line text-rgn end-of-rgn --- top-line ,force region into scrn)
: fit-display local gl local bl preset
dup beot max 900 + eot min wrapthru ( enough info to center text )
findchar #ln @ gl to findchar #ln @ bl to
gl bl - seenlines < if gl bl - else 0 then max ( try to get all of region )
firstseen + gl swap - 0 max ( topline >= 0 )
lastknownline lastseen - 1+ 0 max min ( last ds should show at bottom )
topline to rewindow refresh
gap 1- inwindow if firstseen max lastseen min gapline to then ;
( 4/7:14:56 )
: eos-display bos eos prevchar fit-display ;
: new-display middle eos-display ;
( n --- screen image moves down n lines ) ( 4/8:09:36 )
: scrolldown ?dup 0= if exit then >r ( 0 is noop )
screenstart dup r@ /scan tophalf * * +
seenlines r@ - /scan tophalf * * move
#wtable dup r@ esize * + lastline 1+ r@ - esize * move ( now table )
topline r@ - dup topline to findline ( must go looking for new topline )
#update dup r@ + lastline 1+ r@ - move ( update table also )
r@ 0 do i storeline wrap i firstseen + update! loop lastseen update!
r> negate gapline +to ;
( n --- screen image moves up n lines ) ( 4/8:09:37 )
: scrollup local dist ?dup 0= if exit then ( 0 is noop ) dist to
screenstart dist [ /scan tophalf * ] literal * +
lastseen loadline #spr c@ 0= if lastseen update! then
screenstart seenlines dist - [ /scan tophalf * ] literal *
move
#wtable dist esize * + #wtable lastline 1+ dist - esize * move
#update dist + #update lastline 1+ dist - move ( update table also )
lastline dist - loadline lastline 1+ dup dist - ( wrap rest of window )
do wrap i storeline i lastline - lastseen + update! loop firstseen update!
lastseen dist - update!
dist topline +to dist negate gapline +to ;
( tlh 6/8:1:00 )
: fixcursor cy seenlines 2- > ( cursor over edge? )
if cy seenlines 2- - scrollup refresh seenlines 2- cy to resetcursor then ;
: redisplay preset gapline update! ( 6/23:11:03 )
gap 1- inwindow ( did delete leave gap in window? )
if gapline min gapline to ( moved back but not outside )
gapline firstseen < ( signal for new-display )
else -1
then ( true now indicates need to reconstruct screen )
if firstseen gapline to new-display then
gapline dup stepback ( *** )
dup loadline do wrap loop ( check wrap prev line)
gapline differs? ( change at gap may reflect in prev line and gapline )
if gapline dup stepback dup loadline ( *** )
do i storeline putivl drop wrap i update! loop
then
lastline 1+ gapline ( rewrap rest of screen if necessary )
do i storeline putivl drop i update! wrap ( stop if lines match )
i 1+ differs? #wr @ beot 2+ < or while ( but only after gap )
loop
beot eot < if beot else gap then inwindow ( rewrap off screen )
if dup lastseen 1- >
if lastseen - 1+ scrollup
else firstseen 8 + <
if gap inwindow 0= if firstseen then dup firstseen < ( ::: )
if firstseen swap - scrolldown else drop then
then
then
else gapline firstseen - eos-display
then
gap 1- inwindow if gapline to then gapline update! refresh ;
( tlh 5/20:19:01 )
: partknown ( beyond which ivls may be ok) endtext hideivls ;
: selected
eos inwindow 0= if lastseen then
bos inwindow 0= if firstseen then
2dup > if swap then 1+ swap
do i update! loop ;
: pushpos ( -- n1 n2 n3 n4 n5 n6 | save key variables on stack )
op pop cstate topline bos eos ;
( swap saved and current states of the editor ) ( tlh 5/11:15:18 )
: swappos2 local dist topline oldtopline2 - dist to selected
pushpos oldeos2 dup gap beot 1- inrange if gap + beot - then eos to
movegap ( reposition text same as it was )
oldbos2 bos to oldcstate2 cstate to oldop2 op to oldpop2 pop to
dist abs seenlines <
if dist 0< if dist abs scrollup else dist scrolldown then
else oldtopline2 topline to rewindow
then ?extended if extend then selected refresh resetcursor
oldeos2 to oldbos2 to oldtopline2 to oldcstate2 to oldpop2 to
oldop2 to ;
: savepos ( -- | saves the state of some key variables )
op oldop to
pop oldpop to
bos oldbos to
cstate oldcstate to
eos oldeos to
topline oldtopline to ;
( swap saved and current states of the editor ) ( tlh 7/03:17:27 )
: swappos local dist topline oldtopline - dist to selected
dist 0< if drop gap then
oldeos dup gap 1+
beot 1- inrange if gap + beot - then eos to
movegap ( reposition text same as it was )
oldcstate cstate to oldop op to oldpop pop to
?extended if oldbos else gap prevchar then bos to
dist abs lastseen firstseen - <
if dist 0< if dist abs scrollup else dist scrolldown then
else oldtopline topline to rewindow
then ?extended if extend then selected refresh resetcursor
oldeos to oldbos to oldtopline to oldcstate to oldpop to
oldop to ;
( tlh 3/02:13:42 )
: savepos2 ( -- | saves the state, used by creep and scroll )
op oldop2 to pop oldpop2 to bos oldbos2 to
cstate oldcstate2 to eos oldeos2 to topline oldtopline2 to ;
: collapse
selected bos op to gap prevchar bos to refresh
widecursor forceop on ( ['] extend undop to ) ;
: enoughforth ( space -- true | available false )
applic here - < dup not if applic here - swap then ;
: shiftkey? ( keycharacter -- flag ) ff00 and ff00 = ;
: upkey? ( keycharacter -- flag ) ff80 and ff80 = ;
: lockedtext? ( addr -- flag )
dup c@ ds = ( if on a ds )
if dup findchar #lock c@ lok = ( then check both doc )
swap nextchar findchar #lock c@ lok = or ( and after the doc )
else findchar #lock c@ lok = then ; ( else, regular check )
: lockedrange? ( addr1 addr2 -- flag | for now 0 )
local locked?
dup lockedtext? locked? to ( use end of range for initial flag )
swap
begin 2dup > while
dup lockedtext? ( use our test for locked text )
if locked? on leave then
dup eot prevchar <> while ( if we did text end of text, leave )
nextchar nextdoc
again 2drop locked? ;
: lockedsel ( -- )
bos gap lockedrange?
if bos eos = if eos prevchar bos to then
lockedtext error abort
then ;
: setgap ( -- ) narrowcursor? eos eor = or ( if we need to )
if gap prevchar eos to movegap ( move the gap around )
gapline 1- update! ( and mark for reshowing )
then ;
: stripshifts ( keycharacter -- keycharacterw/oshifts ) ffff and ;
: resetselection? ( -- flag ) forceop dup off ;
( words for helping with spliting out sections of text )
( tlh 3/05:17:27 )
code fpkt? ( addr -- flag | true if break with a format following it )
sp )+ a0 move, ds #n a0 )+ .b cmpi, eq if, dpktsize 1- #n a0 add, then,
0 #n d0 moveq, &fmt #n a0 ) .b cmpi, eq if, -1 #n d0 moveq, then,
d0 sp -) move, next;
( tlh 3/05:17:58 )
code <swappkt> ( addr1 addr2 -- )
sp )+ a0 move, ds #n a0 )+ .b cmpi, eq if, dpktsize 1- #n a0 add, then,
sp )+ a1 move, ds #n a1 )+ .b cmpi, eq if, dpktsize 1- #n a1 add, then,
( advance past breaks )
pktsize 1- #n d2 move, ( for the size of the packet )
begin, a0 ) d0 .b move, ( get byte from first packet )
a1 ) d1 .b move, ( get byte from second packet )
d1 a0 )+ .b move, ( store second at first )
d0 a1 )+ .b move, ( store first at second )
d2 nt -until, next; ( for all the bytes in the packet )
: movepkt ( source destination -- | assumed both are before gap )
local dest brk+ dest to ( skip break before packet )
local source brk+ source to ( and here too )
pktsize needtext ( see if enough room for a simple move )
if source gap pktsize move ( if so, move packet to gap )
source dest < ( is source before dest? )
if source pktsize + source over dest swap - move ( yes )
pktsize negate dest +to ( and adjust dest )
else dest dup pktsize + source dest - move then ( no )
gap dest pktsize move ( and move packet into dest )
else source pktsize reverse ( not enough room, reverse packet )
source dest < ( is source less than dest )
if source pktsize dest over - reverse ( if so, reverse other text )
source dest reverse ( and whole range )
else source dest over - reverse ( if not, reverse text )
source dest pktsize + over - reverse ( and whole range )
then
then ;
: swappkt ( addr1 addr2 -- )
over fpkt? ( if packet at first break )
if dup fpkt? ( is there a packet at second break? )
if <swappkt> ( if so, just swap in place )
else movepkt then ( otherwise move first to second )
else dup fpkt? ( if not at first, is one at second? )
if swap movepkt then ( if so, move second to first )
then ; ( otherwise, none, so do nothing )
: copypkt ( source destination -- ) brk+ swap brk+ swap pktsize move ;
( tlh 5/11:00:01 )
: makespace ( addr len -- addr' )
local len len to ( size of hole to make )
local addr addr to ( where the hole is to be located )
len needtext outofroom ( see if there is enough room to do it )
addr beot < ( is place in first half of text? )
if addr dup len + gap addr - move ( if so, move text up )
addr gap 1+ len realign
addr ( and hole is at desired position )
else bou dup len - addr bou - move ( else in second half of text )
bou addr len negate realign ( only adjust through end of hole )
addr len - ( and that was the end of the hole )
then preset ;