4 % Licensed by GNU GPL v3 or later version.
6 \def\title
{\TeX nicard
}
7 \def\covernote
{{\fiverm Batteries not included. Do not use this book as a
8 flotation device. This is free software
; see source file for details.
}}
10 % Prevent \outer from getting in the way
, stupid
!
14 ``u
{YJ
"@<Predeclaration of procedures@>=
21 \long\def\IndexCharacter#1':{`\.{\char`#1}'}
24 qAqA
/@^\IndexCharacter\
34 \newcount\bibliocount \bibliocount
=0
36 \advance\bibliocount by
1 %
37 $^
{[\the\bibliocount
]}$
%
38 \expandafter\def\csname biblio \the\bibliocount\endcsname
{#
1}%
41 \emergencystretch
=\hsize
45 \rlap
{\vrule height
3.2pt depth
-2.5pt width \wd0
}{\box0
}%
48 @
*Introduction. This is \TeX nicard
, a program designed for similar
49 purposes of Magic Set Editor
, but in a different
(and better
) way. It
50 should be able to produce higher quality cards than Wizards of the Coast
,
51 and then they ought to use this program
, too
!
54 @^Wizards of the Coast@
>
55 @^commercial viability@
>
58 @
<Memory usage logging@
>@
;
59 @
<Interpreted C codes@
>@
;
64 @
<The include file for memory managed types@
>@
;
65 @
<Global variables@
>@
;
66 @
<Predeclaration of procedures@
>@
;
69 @ This line below should be changed with the current version number
,
70 whenever a new version is released.
(If you fork this program
, you should
71 also include some indication of forking in the \\
{version\_string
}.
)
72 % (it doesn't work if I use vertical bars here
)
76 @d version_string
"0.1"
77 @d version_number
1 // one major is worth ten minors
80 typedef unsigned char boolean
;
82 @ You might be wondering what this section is for
(especially since it
83 appears to be unused
). The reason is that some metamacros use it in order
84 to force the compiler to know the correct line numbers
(in case some lines
85 have been added by metamacros
).
90 @
<Nothing~@
>= /* ...
*/
92 @ There is also memory usage logging. If it is not being compiled for
93 memory usage logging
, it should just ignore these kind of commands.
95 @
<Memory usage logging@
>=
96 #ifndef @
!memusage_log
97 #define memusage_log
(_text
,_arg1
)
100 @
*Memory Management. This program uses a lot of similar memory management
,
101 so they will be defined in this chapter.
103 @^memory management@
>
105 @d none
-1 // indication that a |data_index| means nothing
109 char
*data
; // pointer to array of blocks
(|char
*| for use with |sizeof|
)
110 int used
; // number of blocks used
111 int allocated
; // number of blocks allocated
113 @#typedef int data_index
;
115 @ We will use an interpreted C code here
, which will send output to a
116 header file |
"memory_management.h"|.
118 @
<The include file for memory managed types@
>=
119 #include
"memory_management.h"
121 @ We will need some variables now just to keep track of which kinds of
122 memory managed areas are needed.
124 @
<Interpreted C codes@
>= @
{
125 char
**memory_managed_types
;
126 int num_memory_managed_types
;
127 memory_managed_types
=malloc
(128*sizeof
(char
*));
128 num_memory_managed_types
=0;
131 @ From this code
, the structure will be created in the header file for
132 each type that we need a |memory_of|. This section
, however
, is just a
133 ``wrapper'' code for the template.
135 @f @
!memory_of _decl_head_
// category
9
137 @
<Interpreted C codes@
>= @
{
141 sendc
(0200|'
{'
); // begin interpret mode
142 send
("send_memory_of(\"");
145 sendc
(0200|'
}'
); // end interpret mode
152 @ Here is what it does in order to keep a list of the memory managed
153 types. Note the type name was enclosed in quotation marks
, so now it will
154 be received as a string.
156 @
<Interpreted C codes@
>= @
{
157 void send_memory_of
(char
*s
) {
160 @
<Send the proper name of the memory managed type@
>;
161 for
(i
=0;i
<num_memory_managed_types
;i
++) {
162 if
(!strcmp
(s
,memory_managed_types
[i
])) return
;
164 memory_managed_types
[num_memory_managed_types
++]=s
;
168 @ @
<Send the proper name of the memory managed type@
>= {
174 @ Now the code you get to in order to define the structures in the header
175 file. We are mostly just copying the form of our |managed_memory|
176 structure
, but it will be customized to work with the specific type of the
179 @
<Interpreted C codes@
>= @
{
180 void send_memory_managed_types
() {
182 for
(i
=0;i
<num_memory_managed_types
;i
++) {
183 send
("typedef struct {");
184 send
(memory_managed_types
[i
]);
185 send
("*data; int used; int allocated; } x__");
186 send
(memory_managed_types
[i
]);
192 @ @
(memory_management.h@
>= @
{
193 send_memory_managed_types
();
196 @ These next two subroutines are used to allocate additional memory.
198 @d init_memory
(_a
,_size
) init_memory_
(&(_a),sizeof(*((_a).data)),(_size))
199 @d new_record
(_area
) new_record_
(&(_area),sizeof(*((_area).data)))
201 @
-p void
*init_memory_
(void
*mem
,int record_size
,int num_records
) {
202 managed_memory
*m
=mem
;
203 m-
>data
=malloc
(record_size
*num_records
);
205 m-
>allocated
=num_records
;
206 if
(!m-
>data
) @
<Fatal error due to lack of memory@
>;
210 @ @
-p data_index new_record_
(void
*mem
,int record_size
) {
211 managed_memory
*m
=mem
;
213 if
(m-
>used
>m-
>allocated
) {
215 m-
>data
=realloc
(m-
>data
,m-
>allocated
*record_size
);
217 if
(!m-
>data
) @
<Fatal error due to lack of memory@
>;
218 @
<Zero the new record@
>;
222 @ @
<Fatal error due to lack of memory@
>= {
223 fprintf
(stderr
,"Out of memory\n");
227 @ @
<Zero the new record@
>= {
228 memset
(m-
>data
+(record_size
*(m-
>used-1
)),0,record_size
);
231 @ Now just one more thing. It is useful to have a |foreach| macro to
234 @d foreach
(_var
,_area
) for
(_var
=0;_var
<_area.used
;_var
++)@
;
237 @
*Symbolic Names. There will be some names defined for the use of naming
238 subroutines
, symbolic constants
, patterns
, card areas
, etc. These names
239 are stored in a |managed_memory| called |names|.
241 It also stores references to other things
(defined in later chapters
). The
242 numeric value of a name in |names.data
[x
]| is |x
+256|.
247 @
<More elements of |name_data|@
>@
;
250 @ @
<Global variables@
>=
251 memory_of
(name_data
) names
;
253 @ @
<Initialize memory@
>= init_memory
(names
,16);
255 @ This subroutine finds a name
, adding it if necessary. The number
256 corresponding to it
(as described above
) will be the return value.
258 @
-p int find_name
(char
*name
) {
259 @
<Search for the |name| in |names|@
>;
260 @
<Add the new name
(it was not found
)@
>;
263 @ @
<Search for the |name| in |names|@
>= {
266 if
(!strcmp
(names.data
[i
].name
,name
)) return i
+256;
270 @ @
<Add the new name
(it was not found
)@
>= {
271 int n
=new_record
(names
);
272 names.data
[n
].name
=strdup
(name
);
276 @ A macro will be useful to access the data from a number.
278 @d name_info
(_num
) names.data
[(_num
)-0x0100]
280 @ This code lists the names. It is used for a diagnostic purpose.
282 @
<Display the list of names@
>= {
285 printf
("%d \"%s\
" ",n
+256,names.data
[n
].name
);
286 @
<Display other fields of |names.data
[n
]|@
>;
291 @
*Storage of Tokens. Tokens are stored as
16-bit numbers. Values |
0x0020|
292 to |
0x00FF| represent those ASCII characters
, and |
0x0000| to |
0x001F| are
293 ASCII control codes. Higher numbers represent an index into the |names|
294 array
(where |
0x0101| represents |names.data
[0x0001]|
).
297 @q
[data type of tokens
]@
>
298 typedef unsigned short token
;
300 @ This section lists the ASCII control codes which can be used. Some of
301 them have slightly different meaning from the ASCII standard.
303 @d null_char
0x00 // end of a |raw_data| string or similar things
304 @d pre_null_char
0x01 // becomes |null_char|
305 @d end_transmission
0x04 // marks the end of the last card in this area
306 @d tabulation
0x09 // represents a tab in a
{\TeX
} alignment
307 @d raw_data
0x10 // enter raw
{\TeX
} mode
308 @d whatsit
0x1A // a token for converting into a name token
309 @d escape_code
0x1B // represents a
{\TeX
} control sequence introducer
310 @d record_separator
0x1E // marks the end of a card
311 @d field_separator
0x1F // marks the end of a field of a card
312 @d start_name_code
0x0100
314 @ These tokens are used in card areas
, which are defined
(and described
)
317 @
*Cards. The data of the cards is stored in card areas. Each card area
318 is a list of tokens
, terminated by |record_separator|. The final card in
319 the area is terminated by |end_transmission|.
328 @ @
<More elements of |name_data|@
>=
329 boolean has_card_area
;
330 data_index card_area
;
332 @ @
<Global variables@
>=
333 memory_of
(card_area_data
) card_areas
;
335 @ @
<Initialize memory@
>= init_memory
(card_areas
,1);
337 @ A new card area is created with this.
339 @
-p data_index set_card_area
(int num
) {
340 name_data
*m
=&name_info(num);
341 @
<Use the card area which is already set
, if able@
>;
342 @
<Otherwise
, create a new card area and use the new one@
>;
345 @ @
<Use the card area which is already set
, if able@
>= {
346 if
(m-
>has_card_area
) return m-
>card_area
;
349 @ @
<Otherwise
, create a new card area and use the new one@
>= {
350 data_index n
=new_record
(card_areas
);
352 card_areas.data
[n
].allocated
=0x100;
353 card_areas.data
[n
].tokens
=malloc
(0x100*sizeof
(token
));
354 card_areas.data
[n
].used
=0;
358 @ This subroutine sends a token to a card area.
360 @
-p void send_token
(data_index a
,token x
) {
361 if
(card_areas.data
[a
].allocated
<card_areas.data
[a
].used
+4)
362 @
<Double the allocation of card area tokens@
>;
363 card_areas.data
[a
].tokens
[card_areas.data
[a
].used
++]=x
;
366 @ @
<Double the allocation of card area tokens@
>= {
367 int n
=(card_areas.data
[a
].allocated
*=2)*sizeof
(token
);
368 card_areas.data
[a
].tokens
=realloc
(card_areas.data
[a
].tokens
,n
);
371 @ @
<Display other fields of |names.data
[n
]|@
>= {
372 if
(names.data
[n
].has_card_area
)
373 printf
("C(%d) ",names.data
[n
].card_area
);
376 @ The code in this section is used to ensure that each card area is
377 properly terminated with |end_transmission| marker
, so that when it is
378 time to write the output files
, it will know when to stop.
380 @
<Send |end_transmission| to each card area@
>= {
382 foreach
(a
,card_areas
) send_token
(a
,end_transmission
);
385 @
*Patterns. For pattern matching
, we store the patterns in one memory
386 managed area. The index of the beginning of each pattern area is stored
389 These constants are special codes which can occur in the |text| string
394 @d match_keyword
3 // match a keyword followed by a character in a table
395 @d match_table
4 // match a character using a table
396 @d optional_table
5 // match a character optional using a table
398 @d jump_table
7 // use a table to jump to a marker
399 @d successful_match
8
401 @d forward_one_space
10
402 @d match_left_side
11 // match at beginning of line
403 @d match_right_side
12 // match at end of line
408 unsigned int category
; // category for keywords
409 data_index subroutine
;
413 @ @
<More elements of |name_data|@
>=
414 boolean has_pattern_area
;
415 data_index pattern_area
;
417 @ @
<Global variables@
>=
418 memory_of
(pattern_data
) pattern_areas
;
420 @ @
<Initialize memory@
>= init_memory
(pattern_areas
,4);
422 @ @
<Display other fields of |names.data
[n
]|@
>= {
423 if
(names.data
[n
].has_pattern_area
)
424 printf
("P(%d) ",names.data
[n
].pattern_area
);
427 @ A new pattern area is created with this. The patterns in an area are
428 stored like a linked list. The last one with |next| pointing to nothing
,
429 is the terminator entry.
431 @
-p data_index set_pattern_area
(int num
) {
432 name_data
*m
=&name_info(num);
433 @
<Use the pattern area which is already set
, if able@
>;
434 @
<Otherwise
, create a new pattern area and use the new one@
>;
437 @ @
<Use the pattern area which is already set
, if able@
>= {
438 if
(m-
>has_pattern_area
) return m-
>pattern_area
;
441 @ @
<Otherwise
, create a new pattern area and use the new one@
>= {
442 data_index n
=new_record
(pattern_areas
);
443 m-
>has_pattern_area
=1;
444 pattern_areas.data
[n
].subroutine
=none
;
445 pattern_areas.data
[n
].next
=none
;
449 @ @
<Display the list of patterns@
>= {
451 foreach
(i
,pattern_areas
) {
452 if
(pattern_areas.data
[i
].text
) {
453 printf
("%d:%08X:%d:%d\n",i
,pattern_areas.data
[i
].category
454 ,pattern_areas.data
[i
].subroutine
,pattern_areas.data
[i
].next
456 display_string
(pattern_areas.data
[i
].text
);
462 @
*Keywords. Keywords means words which can be placed on the card and which
463 can have special meanings
, and possibly reminder text.
465 Keywords are stored in a large list in only one keyword area. A category
466 can be given a name
, which will automatically be assigned for the next bit
467 of the keyword category when it is entered the first time.
471 char
*match
; // match text
(can contain pattern codes
)
472 unsigned int category
; // bitfield of categories
475 char
*replacement
; // replacement text or reminder text
478 @ @
<Global variables@
>=
479 unsigned int next_keyword_category
=1;
480 memory_of
(keyword_data
) keywords
;
482 @ @
<Initialize memory@
>= init_memory
(keywords
,4);
484 @ A keyword category is found
(and created
, if it is not found
) using the
487 @
-p unsigned int find_category
(char
*name
) {
488 int i
=find_name
(name
);
489 if
(name_info
(i
).value.number
) {
490 return name_info
(i
).value.number
;
491 } @
+else if
(!name_info
(i
).value.is_string
) {
492 name_info
(i
).value.number
=next_keyword_category
;
493 next_keyword_category
<<=1;
494 if
(!next_keyword_category
)
495 fprintf
(stderr
,"Too many keyword categories: %s\n",name
);
496 return name_info
(i
).value.number
;
500 @ Some stack code commands are used when dealing with reading
/writing
503 In order that you might be able to iterate them
, it will exit out of the
504 current block when trying to read nonexisting keyword info instead of
505 displaying an error message.
507 @
<Cases for system commands@
>=
510 if
(registers
['K'
].number
<0 || registers
['K'
].number
>=keywords.used
)
512 push_num
(keywords.data
[registers
['K'
].number
].extra1
);
513 push_num
(keywords.data
[registers
['K'
].number
].extra2
);
514 push_string
(keywords.data
[registers
['K'
].number
].replacement
);
518 // Write keyword info
519 if
(registers
['K'
].number
<0 || registers
['K'
].number
>=keywords.used
)
520 program_error
("Out of range");
521 free
(keywords.data
[registers
['K'
].number
].replacement
);
522 keywords.data
[registers
['K'
].number
].replacement
=pop_string
();
523 keywords.data
[registers
['K'
].number
].extra2
=pop_num
();
524 keywords.data
[registers
['K'
].number
].extra1
=pop_num
();
528 @ @
<Display the list of keywords@
>= {
530 foreach
(i
,keywords
) {
531 display_string
(keywords.data
[i
].match
);
532 printf
(" [%d:%08X:%d:%d:%d]\n",i
,keywords.data
[i
].category
533 ,keywords.data
[i
].extra1
,keywords.data
[i
].extra2
534 ,strlen
(keywords.data
[i
].replacement
)
539 @
*Card List. A sorted summary list of the cards is kept in one list
,
540 having thirty-two general-purpose numeric fields
, and a pointer to the
541 beginning of the record
(usually the name in which it will be indexed by
).
547 int amount_in_pack
; // used in pack generation
550 @ @
<Global variables@
>=
551 memory_of
(list_entry
) card_list
;
553 @ @
<Initialize memory@
>= init_memory
(card_list
,16);
555 @
*Deck Lists. Deck lists involve lists of cards or rules for cards that
556 belong to a deck or pack.
560 There is one macro |lflag| here just to convert letters to bit flags. For
561 example |lflag
('a'
)| is the least significant bit.
563 @d lflag
(_ch
) (1<<((_ch
)-'a'
))
573 @ @
<Global variables@
>=
574 memory_of
(deck_entry
) deck_lists
;
576 @ @
<More elements of |name_data|@
>=
577 boolean has_deck_list
;
578 data_index deck_list
;
580 @ @
<Initialize memory@
>= init_memory
(deck_lists
,4);
582 @ A new deck list is created with this. The deck entries are stored like a
583 linked list. The terminator has |next| pointing to |none|.
585 @
-p data_index set_deck_list
(int num
) {
586 name_data
*m
=&name_info(num);
587 @
<Use the deck list which is already set
, if able@
>;
588 @
<Otherwise
, create a new deck list and use the new one@
>;
591 @ @
<Use the deck list which is already set
, if able@
>= {
592 if
(m-
>has_deck_list
) return m-
>deck_list
;
595 @ @
<Otherwise
, create a new deck list and use the new one@
>= {
596 data_index n
=new_record
(deck_lists
);
598 deck_lists.data
[n
].next
=none
;
602 @ @
<Display the deck list@
>= {
604 foreach
(i
,deck_lists
) {
606 if
(deck_lists.data
[i
].name
) display_string
(deck_lists.data
[i
].name
);
608 printf
(" [%08X:%d:%d]\n",deck_lists.data
[i
].flags
609 ,deck_lists.data
[i
].amount
,deck_lists.data
[i
].next
);
613 @
*Word Forms. These structures are used to store word form rules
, such as
614 plurals\biblio
{Conway
, Damian. ``An Algorithmic Approach to English
615 Pluralization''. \hskip
0pt plus
1in\hbox
{}
616 \.
{http
://www.csse.monash.edu.au
/\~damian
/papers
/HTML
/Plurals.html
}}. You
617 can store up to four different kinds
, in case of languages other than
627 unsigned char orig
[32];
628 unsigned char dest
[32];
629 boolean left_boundary
;
630 boolean right_boundary
;
633 @ @
<Global variables@
>=
634 memory_of
(word_form_entry
) word_forms
;
636 @ @
<Initialize memory@
>= {
638 init_memory
(word_forms
,16);
641 word_forms.data
[i
].orig
[0]=word_forms.data
[i
].dest
[0]=0;
642 word_forms.data
[i
].next
=i
+1;
643 word_forms.data
[i
].level
=0x7FFFFFFF;
644 word_forms.data
[i
+1].orig
[0]=word_forms.data
[i
+1].dest
[0]=0;
645 word_forms.data
[i
+1].next
=none
;
646 word_forms.data
[i
+1].level
=0;
650 @ Word form rules are added and then inserted in the correct place in the
651 linked list using the |next| field. Entries with a higher numbered level
652 take higher priority
, therefore will be placed before the ones with lower
653 numbered level. Next
, longer |orig| strings come before shorter strings
,
654 since they might be more specific forms of the others and will therefore
657 @
-p data_index add_word_form
(int kind
,int level
,char
*orig
,char
*dest
) {
658 data_index n
=new_record
(word_forms
);
659 @
<Set the fields of the new word form rule@
>;
660 @
<Insert the new word form rule into the linked list@
>;
664 @ The |left_boundary| and |right_boundary| fields specify if they should
665 match only at the boundary. Characters are checked using the \.W table and
666 removed from the string to place in the list.
668 @d last_character
(_str
) ((_str
)[strlen
(_str
)-1])
670 @
<Set the fields of the new word form rule@
>= {
671 word_forms.data
[n
].level
=level
;
672 strcpy
(word_forms.data
[n
].orig
,orig
+(tables
['W'
][*orig
]==2));
673 word_forms.data
[n
].left_boundary
=(tables
['W'
][*orig
]==2);
674 if
((word_forms.data
[n
].right_boundary
=
675 (tables
['W'
][last_character
(word_forms.data
[n
].orig
)]==3)))
676 last_character
(word_forms.data
[n
].orig
)=0;
677 strcpy
(word_forms.data
[n
].dest
,dest
+(tables
['W'
][*dest
]==2));
678 if
(tables
['W'
][last_character
(word_forms.data
[n
].dest
)]==3)
679 last_character
(word_forms.data
[n
].dest
)=0;
682 @ @
<Insert the new word form rule into the linked list@
>= {
683 data_index y
=(kind
&3)<<1; // previous item to |x|
684 data_index x
=word_forms.data
[y
].next
; // current item
686 for
(;x
!=none
;y
=x
,x
=word_forms.data
[y
].next
) {
687 if
(word_forms.data
[x
].next
==none
) break
;
688 @#if
(word_forms.data
[x
].level
<level
) break
;
689 if
(word_forms.data
[x
].level
>level
) continue
;
690 @#if
(strlen
(word_forms.data
[x
].orig
)<s
) break
;
692 word_forms.data
[y
].next
=n
;
693 word_forms.data
[n
].next
=x
;
696 @ Now to do computation of changing a word by word forms. This function
697 expects only one word from input
, or multiple words where the last one
698 should be the word to be converted. Uppercase letters are converted to
699 lowercase for conversion
(but not the other way around
), but if the
700 letters are uppercase in the input
, the output will also have uppercase
701 letters on those positions. The algorithm starts from the right side of
704 The parameter |src| is the input
, and |dest| should point to a buffer
705 which is large enough to store the output string.
709 @
-p data_index reform_word
(int kind
,char
*src
,char
*dest
) {
710 char
*l
=src
+strlen
(src
);
711 data_index n
=word_forms.data
[(kind
&3)<<1].next;
712 strcpy
(dest
,src
); // this is used later
713 @
<Try each word form rule
, following the |next| pointers@
>;
714 return none
; // in case there is nothing to do
717 @ @
<Try each word form rule
, following the |next| pointers@
>= {
720 while
(n
!=none
&& word_forms.data[n].next!=none) {
721 s
=strlen
(word_forms.data
[n
].orig
); @
+ p
=l-s
;
722 @
<Check the characters matching from |p|
, going backwards@
>;
723 n
=word_forms.data
[n
].next
;
727 @ Look ahead for the definition of |wcasecmp|
(true means it matches
).
729 @
<Check the characters matching from |p|
, going backwards@
>= {
731 if
((!word_forms.data
[n
].left_boundary || p
==src
732 || tables
['W'
][p
[-1]])
733 && wcasecmp(word_forms.data[n].orig,p))
734 @
<A match to the word form rules has been found@
>;
735 @
<Go backwards
, stop if we are not allowed to continue backwards@
>;
739 @ @
<A match to the word form rules has been found@
>= {
741 sprintf
(o
,"%s%s",word_forms.data
[n
].dest
,p
+s
);
742 @
<Change the capitalization to match the original@
>;
746 @ Remember
, that for example if ``cow'' becomes ``kine''
, then ``Cow''
747 will become ``Kine''. So
, it will retain capitalization.
751 @
<Change the capitalization to match the original@
>= {
752 char
*q
=word_forms.data
[n
].orig
;
753 for
(;*p
&& *q;p++,o++,q++) if(*p==tables['U'][*q]) *o=tables['U'][*o];
756 @ @
<Go backwards
, stop if we are not allowed to continue backwards@
>= {
757 if
(word_forms.data
[n
].right_boundary
) break
; // matches only on boundary
758 if
(tables
['W'
][p
[s
]]) break
; // only the last word
(s
) can be matched
759 if
(p--
==src
) break
; // stop at beginning
762 @ This function is defined to compare strings in the way needed for
763 matching word forms
, including case conversion. The lowercase letters in
764 the |shorter| string are permitted to match lowercase and uppercase
765 letters in the |longer| string
, and the |shorter| string is permitted to
766 be shorter and still match.
768 @
-p boolean wcasecmp
(char
*shorter
,char
*longer
) {
769 for
(;;shorter
++,longer
++) {
770 if
(!*shorter
) return
1;
771 if
(!*longer
) return
0;
772 if
(*shorter
!=*longer
&& *shorter!=tables['L'][*longer]) return 0;
776 @ Of course it is now needed a command that can access these features from
777 within a \TeX nicard template. The |level| of the matched rule is also
778 returned
, in case your program might use that information for something.
780 @
<Cases for system commands@
>=
782 // Convert a word form
786 data_index n
=reform_word
(k
,o
,q
);
788 if
(n
==none
) push_num
(0);
789 else push_num
(word_forms.data
[n
].level
);
794 @ @
<Display the list of word form rules@
>= {
796 foreach
(i
,word_forms
) {
797 printf
("%d %c\"",i,word_forms.data[i].left_boundary?'[':' ');
798 display_string(word_forms.data[i].orig);
799 printf("\
"%c -> \"",word_forms.data[i].right_boundary?']':' ');
800 display_string(word_forms.data[i].dest);
801 printf("\
" %d >%d\n",word_forms.data
[i
].level
802 ,word_forms.data
[i
].next
);
806 @
*Random Number Generation. This program uses the Xorshift algorithm
,
807 invented by George Marsaglia\biblio
{Marsaglia
(July
2003). ``Xorshift
808 RNGs''. Journal of Statistical Software Vol.~
8 (Issue
14).
{\tt
809 http
://www.jstatsoft.org
/v08
/i14
/paper
}.
}.
811 @^Marsaglia
, George@
>
814 @
<Global variables@
>=
820 @ @
<Initialize the random number generator@
>= {
821 @q
[initialize the random seed
::]@
>
822 rng_seed
((unsigned int
)time
(0));
823 @q
[::initialize the random seed
]@
>
826 @ The seed parameters for the random number generator will be seeded using
827 the linear congruential generator
, which is a simpler generator which can
828 be used to seed it with.
830 The parameters |lcg_a| and |lcg_c| are parameters to the linear
831 congruential generator algorithm. The values used here are the same as
832 those used in GNU C. In this program they will be specified explicitly so
833 that you can get identical output on different computers.
838 @
-p void rng_seed
(unsigned int x
) {
839 rng_x
=x
=lcg_a
*x
+lcg_c
;
840 rng_y
=x
=lcg_a
*x
+lcg_c
;
841 rng_z
=x
=lcg_a
*x
+lcg_c
;
842 rng_w
=x
=lcg_a
*x
+lcg_c
;
845 @ There is a command to reseed it using a constant
(so that you can
846 generate the same numbers on different computers
).
848 @
<Cases for system commands@
>=
850 // Reseed the random number generator
851 if
(stack_ptr-
>is_string
) program_error
("Type mismatch");
856 @ And now follows the algorithm for generating random numbers. One change
857 has been made so that once it is modulo
, all number will still be of equal
860 Numbers are generated in the range from
0 up to but not including |limit|.
862 @d max_uint
((unsigned int
)(-1))
864 @
-p unsigned int gen_random
(unsigned int limit
) {
865 unsigned int r
=max_uint-
(max_uint
%limit
); // range check
867 @
<Make the next number |rng_w|...@
>;
868 @
<Check the range
, try again if out of range
, else |return|@
>;
872 @ @
<Make the next number |rng_w| by Xorshift algorithm@
>= {
873 unsigned int t
= rng_x ^
(rng_x
<< 11);
874 rng_x
= rng_y
; @
+ rng_y
= rng_z
; @
+ rng_z
= rng_w
;
875 rng_w ^
= (rng_w
>> 19) ^ t ^
(t
>> 8);
878 @ @
<Check the range
, try again if out of range
, else |return|@
>= {
879 if
(rng_w
<=r
) return rng_w
%limit
;
882 @ @
<Cases for system commands@
>=
884 // Generate a random number
885 if
(stack_ptr-
>is_string
) program_error
("Type mismatch");
886 stack_ptr-
>number
=gen_random
(stack_ptr-
>number
);
890 @
*Stack Programming Language. Now we get to the part where the user can
891 enter a program
, in order to control the features of this program. The
892 programming language used is like \.
{dc
}, but different.
896 Subroutines are simply stored as strings in the |names| area
, since they
897 are the same as registers.
899 @ Now we have the storage of registers. Registers
0 to
255 are stored in
900 this separate list
, while other register values are just stored in the
901 |names| list. There is also a stack
, which has storage of the same values
902 as registers can contain.
915 @ @
<More elements of |name_data|@
>=
916 register_value value
;
918 @ @
<Global variables@
>=
919 register_value registers
[256];
920 register_value stack
[max_stack
];
921 register_value
*stack_ptr
=stack-1
; // current top of stack element
923 @ Here are some codes for pushing and popping the stack.
925 @d pop_num
() ((stack_ptr--
)->number
)
927 @
-p inline void push_string
(char
*s
) {
929 stack_ptr-
>is_string
=1;
930 stack_ptr-
>text
=strdup
(s
);
933 @ @
-p inline void push_num
(int n
) {
935 stack_ptr-
>is_string
=0;
939 @ @
-p inline void stack_dup
(void
) {
940 if
((stack_ptr
[1].is_string
=stack_ptr-
>is_string
)) {
941 stack_ptr
[1].text
=strdup
(stack_ptr-
>text
);
943 stack_ptr
[1].number
=stack_ptr-
>number
;
948 @ @
-p inline void stack_drop
(void
) {
949 if
(stack_ptr-
>is_string
) free
(stack_ptr-
>text
);
953 @ @
-p inline char
*pop_string
(void
) {
954 char
*p
=stack_ptr-
>text
;
955 stack_ptr-
>is_string
=0; stack_ptr-
>text
=0;
960 @ Also
, some subroutines are needed here in order to deal with registers.
962 For |fetch_code|
, the string |
"0[]+"| is returned if it is not a string
,
963 generating a ``Type mismatch'' error when you try to run it.
965 @
-p inline char
*fetch_code
(int r
) {
967 if
(!registers
[r
].is_string
) return
"0[]+";
968 return registers
[r
].text
;
970 if
(!name_info
(r
).value.is_string
) return
"0[]+";
971 return name_info
(r
).value.text
;
975 @ @
-p inline void fetch
(int r
) {
977 if
(!(r
&~0xFF)) v=&(registers[r]);
978 else v
=&(name_info(r).value);
979 (++stack_ptr
)->is_string
=v-
>is_string
;
981 stack_ptr-
>text
=strdup
(v-
>text
);
983 stack_ptr-
>number
=v-
>number
;
987 @ @
-p inline void store
(int r
) {
989 if
(!(r
&~0xFF)) v=&(registers[r]);
990 else v
=&(name_info(r).value);
991 if
(v-
>is_string
) free
(v-
>text
);
992 v-
>is_string
=stack_ptr-
>is_string
;
994 v-
>text
=stack_ptr-
>text
;
996 v-
>number
=stack_ptr-
>number
;
1001 @ There is also a save stack. This save stack stores the saved values of
1002 the registers |'
0'| to |'
9'|
, so that you can have local variables in a
1005 @
<Global variables@
>=
1006 register_value save_stack
[520];
1007 register_value
*save_stack_ptr
=save_stack
;
1009 @ These codes deal with the save stack. Strings will be copied when
1010 saving. When loading
, strings that were previously in the registers will
1013 @
<Save local registers to the save stack@
>= {
1015 for
(i
='
0'
;i
<='
9'
;i
++) {
1016 *save_stack_ptr
=registers
[i
];
1017 if
(registers
[i
].is_string
)
1018 save_stack_ptr-
>text
=strdup
(save_stack_ptr-
>text
);
1023 @ @
<Load local registers from the save stack@
>= {
1025 for
(i
='
9'
;i
>='
0'
;i--
) {
1026 if
(registers
[i
].is_string
) free
(registers
[i
].text
);
1027 registers
[i
]=*--save_stack_ptr
;
1031 @
*Commands for Stack Programming Language. Finally
, is the code where it
1032 can be executed. The return value of this function indicates how many
1033 levels should be exit when it is called.
1035 @
-p int execute_program
(char
*prog
) {
1037 reset_execute_program
:
1040 @
<Cases for literal data commands@
>@
;
1041 @
<Cases for stack manipulation commands@
>@
;
1042 @
<Cases for arithmetic commands@
>@
;
1043 @
<Cases for flow-control commands@
>@
;
1044 @
<Cases for register
/table operation commands@
>@
;
1045 @
<Cases for string commands@
>@
;
1046 @
<Cases for condition
/compare commands@
>@
;
1047 @
<Cases for local registers commands@
>@
;
1048 @
<Cases for system commands@
>@
;
1049 @
-case '?'
: @
<Do a diagnostics command@
>@
;@
+break
;
1051 if
(*ptr
>='
0'
&& *ptr<='9')
1052 @
<Read a literal number and push to stack@
>;
1055 if
(stack_ptr
<stack-1
) program_error
("Stack underflow");
1056 if
(stack_ptr
>stack
+max_stack
) program_error
("Stack overflow");
1061 @ @
<Cases for literal data commands@
>=
1063 // Literal ASCII character
1069 @
<Read a literal string and push to stack@
>;
1074 @
<Read a literal name and push its number to the stack@
>;
1078 @ @
<Read a literal number and push to stack@
>= {
1080 while
(*ptr
>='
0'
&& *ptr<='9') n=10*n+(*ptr++)-'0';
1085 @ @
<Read a literal string and push to stack@
>= {
1093 if
(!*ptr
) program_error
("Unterminated string literal");
1099 @ @
<Read a literal name and push its number to the stack@
>= {
1101 while
(*ptr
&& *ptr!=')') ptr++;
1102 if
(!*ptr
) program_error
("Unterminated string literal");
1104 push_num
(find_name
(p
));
1108 @ @
<Cases for stack manipulation commands@
>=
1110 // Drop top item of stack
1115 // Clears the stack
, rendering it empty
1116 while
(stack_ptr
>=stack
) stack_drop
();
1120 // Duplicates the value on top of the stack.
1125 // Swaps the top two values on the stack
1126 stack_ptr
[1]=stack_ptr
[0];
1127 stack_ptr
[0]=stack_ptr
[-1];
1128 stack_ptr
[-1]=stack_ptr
[1];
1132 @ @
<Cases for arithmetic commands@
>=
1134 // Add two numbers
, or concatenate two strings
1135 if
(stack_ptr-
>is_string
) {
1136 @
<Concatenate strings on the stack@
>;
1139 if
(stack_ptr-
>is_string
)
1140 program_error
("Type mismatch");
1141 stack_ptr-
>number
+=n
;
1146 // Subtract two numbers
, or compare two strings
1147 if
(stack_ptr-
>is_string
) {
1148 @
<Compare strings on the stack@
>;
1151 if
(stack_ptr-
>is_string
)
1152 program_error
("Type mismatch");
1153 stack_ptr-
>number-
=n
;
1158 // Multiply two numbers
1160 if
(stack_ptr
[0].is_string || stack_ptr
[1].is_string
)
1161 program_error
("Number expected");
1162 stack_ptr-
>number
*=n
;
1166 // Divide two numbers
1168 if
(stack_ptr
[0].is_string || stack_ptr
[1].is_string
)
1169 program_error
("Number expected");
1170 if
(n
==0) program_error
("Division by zero");
1171 stack_ptr-
>number
/=n
;
1175 // Modulo of two numbers
1177 if
(stack_ptr
[0].is_string || stack_ptr
[1].is_string
)
1178 program_error
("Number expected");
1179 if
(n
==0) program_error
("Division by zero");
1180 stack_ptr-
>number
%=n
;
1184 @ @
<Concatenate strings on the stack@
>= {
1185 char
*s
=pop_string
();
1187 if
(!stack_ptr-
>is_string
) program_error
("Type mismatch");
1188 q
=malloc
(strlen
(s
)+strlen
(stack_ptr-
>text
)+1);
1189 strcpy
(q
,stack_ptr-
>text
);
1190 strcpy
(q
+strlen
(q
),s
);
1197 @ @
<Compare strings on the stack@
>= {
1198 char
*s
=pop_string
();
1199 char
*q
=pop_string
();
1200 push_num
(strcmp
(q
,s
));
1205 @ @
<Cases for flow-control commands@
>=
1207 // Exit from multiple levels
1213 // Go back to beginning
1218 // Exit from two levels
1223 // Execute code from top of stack
1224 @
<Execute a string or subroutine code from top of stack@
>;
1228 @ Note here
, it is a recursive function call.
1231 @
<Execute a string or subroutine code from top of stack@
>= {
1232 if
(stack_ptr-
>is_string
) {
1233 char
*p
=pop_string
();
1234 int q
=execute_program
(p
);
1238 char
*p
=fetch_code
(pop_num
());
1239 int q
=execute_program
(p
);
1244 @ @
<Cases for register
/table operation commands@
>=
1246 // Store value to table
1248 if
(stack_ptr-
>is_string
) program_error
("Number expected");
1250 tables
[0x7F&*++ptr][n]=pop_num();
1254 // Load value from table
1255 stack_ptr-
>number
=tables
[0x7F&*++ptr][stack_ptr->number];
1259 // Load value from register named by stack
1260 if
(stack_ptr-
>is_string
) program_error
("Number expected");
1265 // Store value in register named by stack
1266 if
(stack_ptr-
>is_string
) program_error
("Number expected");
1271 // Load value from register
1276 // Store value in register
1281 @ @
<Cases for string commands@
>=
1283 // Put brackets around a string
, or convert number to text
1284 if
(stack_ptr-
>is_string
) {
1285 @
<Put brackets around string at top of stack@
>;
1287 @
<Convert top of stack to string representation of a number@
>;
1292 // Calculate number of characters in a string
1293 char
*s
=pop_string
();
1294 push_num
(strlen
(s
));
1299 // ``ASCIIfy'' a number
1300 if
(stack_ptr-
>is_string
) {
1301 if
(stack_ptr-
>text
[0]) stack_ptr-
>text
[1]=0;
1303 int n
=stack_ptr-
>number
;
1304 stack_ptr-
>is_string
=1;
1305 stack_ptr-
>text
=malloc
(2);
1306 stack_ptr-
>text
[0]=n
;
1307 stack_ptr-
>text
[1]=0;
1312 // Take the first character from the string
1313 char
*s
=stack_ptr-
>text
;
1314 if
(!stack_ptr-
>is_string ||
!*s
) return
0;
1316 stack_ptr
[-1].text
=strdup
(s
+1);
1321 @ @
<Put brackets around string at top of stack@
>= {
1322 char
*buf
=malloc
(strlen
(stack_ptr-
>text
)+3);
1323 sprintf
(buf
,"[%s]",stack_ptr-
>text
);
1324 free
(stack_ptr-
>text
);
1325 stack_ptr-
>text
=buf
;
1328 @ @
<Convert top of stack to string representation of a number@
>= {
1330 sprintf
(buf
,"%d",stack_ptr-
>number
);
1335 @ Here is how the ``Arithmetic
IF'' command works
: On the stack you have
1336 any three values at the top
, and a number underneath it. Those are all
1337 removed
, except one of the three values which is selected based on the
1338 sign of the number
(the condition value
).
1340 @
<Cases for condition
/compare commands@
>=
1343 @
<Do the ``Arithmetic
IF''@
>;
1349 if
(stack_ptr
[0].is_string || stack_ptr
[1].is_string
)
1350 program_error
("Number expected");
1351 stack_ptr-
>number
&=n;
1355 @ Do you like this algorithm? Is this a real question?
1359 @
<Do the ``Arithmetic
IF''@
>= {
1360 register_value v
=stack_ptr
[-3];
1363 stack_ptr
[-3]=stack_ptr
[n
];
1365 stack_drop
();@
+stack_drop
();@
+stack_drop
();
1368 @ @
<Cases for local registers commands@
>=
1371 @
<Save local registers to the save stack@
>;
1376 @
<Load local registers from the save stack@
>;
1380 @ When there is a program error
(such as stack underflow
), the following
1381 subroutine is used to handle it.
1383 @d program_error
(_text
) program_error_
(prog
,ptr
,_text
)
1385 @
-p void program_error_
(char
*prog
,char
*ptr
,char
*msg
) {
1386 fprintf
(stderr
,"Error in %s on line %d",current_filename
,current_line
);
1387 fprintf
(stderr
,"\n! %s\ns%dS%dp%d near \"",msg,stack_ptr-stack,
1388 save_stack_ptr-save_stack,ptr-prog);
1389 @<Display the codes near the part that caused the error@>;
1390 fprintf(stderr,"\
"\n");
1394 @ @
<Display the codes near the part that caused the error@
>= {
1398 if
(p
<prog || p
>ptr
) p
=prog
;
1399 for
(i
=0;p
+i
<=ptr
&& p[i];i++) buf[i]=p[i];
1401 fprintf
(stderr
,"%s",buf
);
1404 @
*Tables and registers. The tables must be stored here. There are
128
1405 tables with
256 entries each
, each of which can store one byte of data.
1406 These tables are used for converting uppercase
/lowercase
, for deciding
1407 which characters need to be escaped in \TeX
, and so on.
1409 The purposes of the built-in registers are also described in this chapter.
1410 The tables and registers named by uppercase letters are for system use.
1411 The tables and registers named by lowercase can be used by the user.
1413 @
<Global variables@
>=
1414 unsigned char tables
[128][256];
1416 @ Here are the uses of the built-in tables and registers
:
1417 @^built-in registers@
>
1420 Register \.A
: The current position in the current cards area.
1422 Register \.C
: The current cards area.
1424 Register \.D
: Dots per inch
, multiplied by
100.
1426 Register \.E
: The escape character for \TeX. If this is a string
, the
1427 entire string is the prefix
; otherwise
, it is a ASCII number of the
1428 character to be used.
1430 Register \.K
: Index number for last keyword entry added. Also used when
1431 dealing with keyword operation commands
, and when a keyword is matched in
1434 Register \.P
: The current pattern area.
1436 Register \.Q
: The parameters for the ImageMagick command-line
, separated
1439 Register \.T
: Alignment tab character for \TeX. Same considerations apply
1440 as the \.E register.
1442 Register \.U
: A code to execute for a deck specification enrty with \.x
1445 Register \.V
: The version number of this program.
1447 Register \.W
: A code which pushes the whatsit replacements onto the stack.
1448 It is initialized to a blank string before each line in a card area. It
1449 should push the replacements in the reverse order of the whatsits
, so you
1450 could use a code like this
, for example
: \.
{[(Abracadabra
)]lW
+sW
}
1452 Register \.
X: Horizontal coordinate across the page
(in pixels
).
1454 Register \.
Y: Vertical coordinate across the page
(in pixels
).
1456 Register \.Z
: Should be set to a code to execute after doing everything
1457 else
(but before writing output files
).
1459 Table \.E
: Indicates which characters need escaped for \TeX.
1461 Table \.G
: Table containing information for sorting and grouping.
1463 Table \.L
: Conversion to lowercase.
1465 Table \.S
: Information for natural sorting.
1467 Table \.U
: Conversion to uppercase.
1469 Table \.W
: Table for word form rules. Zero means a letter
, one means a
1470 word separator
, two means use to mark beginning of a word
, three means use
1471 to mark the end of a word. In this program
, it is advantageous to use the
1472 fact that zero means word characters
(such as letters
), and nonzero means
1475 @d init_register
(_reg
,_val
) do@
+{
1476 registers
[_reg
].is_string
=0;
1477 registers
[_reg
].number
=(_val
);
1480 @d init_register_str
(_reg
,_val
) do@
+{
1481 registers
[_reg
].is_string
=1;
1482 registers
[_reg
].text
=strdup
(_val
);
1485 @
<Initialize the tables and registers@
>= {
1487 for
(i
=0;i
<256;i
++) init_register
(i
,0);
1488 init_register
('E'
,'\\'
);
1489 init_register
('V'
,version_number
);
1490 @
<Initialize table of alphabetical case conversion@
>;
1493 @ @
<Initialize table of alphabetical case conversion@
>= {
1494 for
(i
=0;i
<256;i
++) tables
['L'
][i
]=tables
['U'
][i
]=i
;
1495 for
(i
='A'
;i
<='Z'
;i
++) {
1496 tables
['L'
][i
]=i
+'a'
-'A'
;
1497 tables
['U'
][i
+'a'
-'A'
]=i
;
1501 @ @
<Display the contents of table |
*++ptr|@
>= {
1504 for
(i
=0;i
<256;i
++) {
1505 printf
("%c%c",tables
[t
][i
]?'
+'
:'.'
,@|
1506 (tables
[t
][i
]<0x7F && tables[t][i]>=' ')?tables[t][i]:'.'
1508 if
((i
&0x0F)==0x0F) printf("\n");
1510 for
(i
=' '
;i
<0x7F;i
++) if
(tables
[t
][i
]) printf
("%c",i
);
1513 @
*Diagnostics. Here is diagnostics commands. These are used to display the
1514 internal information on standard output
, so that you can check how these
1515 things are working.
(You can also use \.
{gdb
} for debugging purposes.
) A
1516 diagnostics command always starts with a question mark
, and is then
1517 followed by one more character indicating the type of diagnostics
1518 requestsed.
(Some are followed by an additional character after that.
)
1520 @
<Do a diagnostics command@
>= {
1522 case 'c'
: @
<Display the sorted card list@
>; @
+break
;
1523 case 'd'
: @
<Display the deck list@
>; @
+break
;
1524 case 'k'
: @
<Display the list of keywords@
>; @
+break
;
1525 case 'n'
: @
<Display the list of names@
>; @
+break
;
1526 case 'p'
: @
<Display the list of patterns@
>; @
+break
;
1527 case 's'
: @
<Display the contents of the stack@
>; @
+break
;
1528 case 't'
: @
<Display the contents of table |
*++ptr|@
>; @
+break
;
1529 case 'w'
: @
<Display the list of word form rules@
>; @
+break
;
1530 default
: program_error
("Unknown type of diagnostics");
1534 @ One subroutine is used here for displaying strings with escaped
, so that
1535 it will display on a terminal without messing it up or omitting the
1536 display of some characters.
1538 @
-p void display_string
(char
*s
) {
1540 if
(*s
<' ' ||
*s
==0x7F) {
1541 printf
("^%c",0x40^
*s
);
1548 @ @
<Display the contents of the stack@
>= {
1550 for
(p
=stack
;p
<=stack_ptr
;p
++) {
1553 display_string
(p-
>text
);
1556 printf
("%d\n",p-
>number
);
1561 @ More of the diagnostics functions are included in the chapters for the
1562 data structures which it is displaying.
1564 @
*Pattern Matching. Now
, finally
, after the chapter about patterns
, and
1565 going through many other things in between
, comes to the chapter in which
1566 patterns are actually being matched.
1568 One structure is used here for the information about how to match it
, and
1569 what has been matched from it. The parameter |num_capture| is how many
1570 captured parts there are
, and the |start| and |end| arrays store the index
1571 into the |src| string of where the matches are. The entire matched part is
1572 indicated by |start
[0]| and |end
[0]|
(note always |start
[0]==0|
).
1577 char
*truesrc
; // used for checking true beginning of the line
1579 unsigned int category
;
1585 @ This first one just matches one pattern against a string to see if it
1586 matches. It returns true if it does match.
(It is somewhat inefficient.
)
1588 @
-p boolean match_pattern
(match_info
*mat
) {
1589 char
*src
; // current start of source string
1590 char
*ptr
; // pointer into source string |src|
1591 char
*pptr
; // pointer into pattern string
1592 src
=mat-
>src
; @
+ mat-
>num_capture
=0; @
+ pptr
=mat-
>pattern
; @
+ ptr
=src
;
1593 @
<Execute the pattern on the string |src|@
>;
1597 @ This loop executes each command in the pattern in attempt to match each
1598 character. In case of mismatch
, it will break out of this loop
, and
1599 continue with the next iteration of the loop in the previous section.
1601 @d not_a_marker
!(pptr
[-1]&0x80)
1603 @
<Execute the pattern on the string |src|@
>= {
1607 mat-
>start
[++mat-
>num_capture
]=ptr-mat-
>src
; @
+break
;
1608 case end_capture
: mat-
>end
[mat-
>num_capture
]=ptr-mat-
>src
; @
+break
;
1609 case match_keyword
: @
<Do |match_keyword|@
>; @
+break
;
1611 if
(!tables
[*pptr
++][*ptr
++]) goto mismatch
; @
+break
;
1612 case optional_table
: ptr
+=!!tables
[*pptr
++][*ptr
]; @
+break
;
1613 case failed_match
: goto mismatch
;
1615 if
(!(pptr
=strchr
(mat-
>pattern
,0x80|tables
[*pptr
++][*ptr
++])))
1618 case successful_match
: @
<Do |successful_match|@
>;
1619 case back_one_space
: if
(ptr--
==mat-
>src
) goto mismatch
; @
+break
;
1620 case forward_one_space
: if
(!*ptr
++) goto mismatch
; @
+break
;
1621 case match_left_side
: if
(ptr
!=mat-
>truesrc
) goto mismatch
; @
+break
;
1622 case match_right_side
: if
(*ptr
>=' '
) goto mismatch
; @
+break
;
1623 default
: if
(not_a_marker
&& pptr[-1]!=*ptr++) goto mismatch;
1628 @ @
<Do |successful_match|@
>= {
1630 mat-
>end
[0]=ptr-mat-
>src
;
1634 @ And now
, the next part matches from an area and changes the string in
1635 place
, possibly by reallocating it. The |src| pointer passed to this
1636 function should be one that can be freed
!
1638 @
-p char
*do_patterns
(char
*src
,int area
) {
1641 int index
=0; // index into |src| string
1642 @
<Cancel if there isn't a pattern area@
>;
1644 if
(index
>=strlen
(src
)) return src
;
1645 pat
=pattern_areas.data
+name_info
(area
).pattern_area
;
1647 @
<Fill up the |mat| structure for testing the current pattern@
>;
1648 if
(mat.pattern
&& match_pattern(&mat)) {
1649 @
<Push the captured strings to the stack@
>;
1650 @
<Call the subroutine associated with this pattern@
>;
1651 if
(stack_ptr-
>is_string
) {
1652 @
<Replace the matched part from the stack and fix the |index|@
>;
1657 goto continue_matching
;
1659 @
<Select the next pattern in this area or |break|@
>;
1661 index
++; @
+ goto continue_matching
;
1664 @ @
<Cancel if there isn't a pattern area@
>= {
1665 if
(area
<256) return src
;
1666 if
(!name_info
(area
).has_pattern_area
) return src
;
1669 @ @
<Fill up the |mat| structure for testing the current pattern@
>= {
1672 mat.pattern
=pat-
>text
;
1673 mat.category
=pat-
>category
;
1676 @ @
<Push the captured strings to the stack@
>= {
1678 for
(i
=mat.num_capture
;i
;i--
) {
1679 push_string
(src
+index
+mat.start
[i
]);
1680 stack_ptr-
>text
[mat.end
[i
]-mat.start
[i
]]=0;
1684 @ @
<Call the subroutine associated with this pattern@
>= {
1685 execute_program
(names.data
[pat-
>subroutine
].value.text
);
1688 @ The memory allocated is probably more than is needed
, but this way is
1689 simpler. It is always sufficient amount
, though. Think about it.
1693 @
<Replace the matched part from the stack and fix the |index|@
>= {
1694 char
*q
=malloc
(strlen
(src
)+strlen
(stack_ptr-
>text
)+1);
1696 sprintf
(q
+index
,"%s%s",stack_ptr-
>text
,src
+index
+mat.end
[0]);
1699 index
+=strlen
(stack_ptr-
>text
);
1702 @ @
<Select the next pattern in this area or |break|@
>= {
1703 if
(pat-
>next
==none
) break
;
1704 pat
=pattern_areas.data
+pat-
>next
;
1707 @ Finally
, there is a command |'M'| to do a pattern matching and
1708 replacement with a string
, inside of a stack subroutine code.
1710 @
<Cases for system commands@
>=
1712 // do pattern matching and replacement
1714 if
(!stack_ptr-
>is_string
) program_error
("Type mismatch");
1715 stack_ptr-
>text
=do_patterns
(stack_ptr-
>text
,n
);
1719 @
*Matching Keywords. Codes for matching keywords have been placed in
1720 another chapter
, instead of making the previous chapter longer.
1722 So now we can see how it is matched keywords in a pattern code.
1724 @
<Do |match_keyword|@
>= {
1727 char t
=*pptr
++; // indicate which table to use
1728 data_index best
=none
;
1730 @
<Try matching each keyword belonging to the category@
>;
1731 if
(best
==none
) goto mismatch
;
1732 @
<Adjust the \.K register for this keyword match@
>;
1736 @ @
<Adjust the \.K register for this keyword match@
>= {
1737 if
(registers
['K'
].is_string
) free
(registers
['K'
].text
);
1738 registers
['K'
].is_string
=0;
1739 registers
['K'
].number
=best
;
1742 @ When matching keywords
, all of them will be tried
, in case there are
1743 better candidates for the search
(bigger is better
(so
, for example
,
1744 |
"Power of One"| will override |
"Power"|
); failing that
, later ones are
1745 better than earlier ones
(so that user files can override keywords in
1748 @^Courtenay
, Bryce@
>
1749 @^Houghton
, Israel@
>
1752 @
<Try matching each keyword belonging to the category@
>= {
1754 foreach
(i
,keywords
) {
1755 if
(keywords.data
[i
].category
&mat->category &&
1756 strlen
(keywords.data
[i
].match
)>=best_length
) {
1757 @
<Set up the |match_info| structure called |m|@
>;
1758 @
<Attempt applying this keyword match@
>;
1763 @ @
<Set up the |match_info| structure called |m|@
>= {
1764 sprintf
(mstr
,"%s%c%c%c",
1765 keywords.data
[i
].match
,match_table
,t
,successful_match
);
1766 m.src
=m.truesrc
=ptr
;
1770 @ @
<Attempt applying this keyword match@
>= {
1771 if
(match_pattern
(&m)) {
1773 best_length
=strlen
(keywords.data
[i
].match
);
1777 @
*Sorting and Grouping. The card lists can be sorted
/grouped using these
1778 commands
, which are generally used by macros that create the records for
1779 the cards in the card areas.
1781 @
<Cases for system commands@
>=
1783 // Add a new list entry
1784 data_index n
=new_record
(card_list
);
1785 card_list.data
[n
].token_ptr
=
1786 card_areas.data
[set_card_area
(registers
['C'
].number
)].used
1791 // Set a field value of the list entry
1792 data_index n
=card_list.used-1
;
1795 if
(n
==none
) program_error
("No card list is available");
1796 card_list.data
[n
].field
[x
&31]=y;
1800 @ Other than the commands to make the list entries above
, there must be
,
1801 of course
, the actual sorting and grouping being done
!
1803 Sorting and grouping are controlled by the \.G table. Starting from a
1804 given offset
(added
), you use thirty-two entries for the thirty-two
1807 @
<Cases for system commands@
>=
1810 sorting_table_offset
=pop_num
();
1811 qsort
(card_list.data
,card_list.used
,sizeof
(list_entry
),list_compare
);
1812 @
<Mark positions in the sorted list@
>;
1816 @ @
<Global variables@
>=
1817 int sorting_table_offset
;
1819 @ This is the compare function for the list sorting. It is also worth to
1820 notice here what values belong in the \.G table.
1823 @d primary_ascending 'A'
1824 @d primary_descending 'Z'
1825 @d secondary_ascending 'a'
1826 @d secondary_descending 'z'
1827 @d record_sorted_position 'R'
1829 @d G_table
(_field
) (tables
['G'
][((sorting_table_offset
+(_field
))&0xFF)])
1830 @d p1s
((list_entry
*)p1
)
1831 @d p2s
((list_entry
*)p2
)
1833 @
-p int list_compare
(const void
*p1
,const void
*p2
) {
1834 @
<Compare using fields indicated by \.G table@
>;
1835 @
<Compare using the card's name and the \.S table@
>;
1836 @
<Compare using the order in which the cards are typed in@
>;
1837 return
0; // This can't
, but will
, happen.
1840 @ @
<Compare using fields indicated by \.G table@
>= {
1842 for
(i
=0;i
<32;i
++) if
(p1s-
>field
[i
]!=p2s-
>field
[i
]) {
1843 if
(G_table
(i
)==primary_ascending
) {
1844 return
(p1s-
>field
[i
]>p2s-
>field
[i
])?
1:-1;
1845 } @
+else if
(G_table
(i
)==primary_descending
) {
1846 return
(p1s-
>field
[i
]<p2s-
>field
[i
])?
1:-1;
1849 for
(i
=0;i
<32;i
++) if
(p1s-
>field
[i
]!=p2s-
>field
[i
]) {
1850 if
(G_table
(i
)==secondary_ascending
) {
1851 return
(p1s-
>field
[i
]>p2s-
>field
[i
])?
1:-1;
1852 } @
+else if
(G_table
(i
)==secondary_descending
) {
1853 return
(p1s-
>field
[i
]<p2s-
>field
[i
])?
1:-1;
1858 @ When all else fails
, \strike
{play dead
} use the order in which the cards
1859 have been typed in. This is how it is made stable
, and that you can get
1860 the same results on any computer.
1864 @
<Compare using the order in which the cards...@
>= {
1865 if
(p1s-
>token_ptr
>p2s-
>token_ptr
) return
1;
1866 if
(p1s-
>token_ptr
<p2s-
>token_ptr
) return
-1;
1869 @ The last thing to do after sorting
, is mark positions in the list if it
1870 is requested to do so.
1872 @
<Mark positions in the sorted list@
>= {
1876 if
(G_table
(j
)==record_sorted_position
) {
1877 foreach
(i
,card_list
) card_list.data
[i
].field
[j
]=i
;
1882 @ @
<Display the sorted card list@
>= {
1885 foreach
(i
,card_list
) {
1886 printf
("%d=[ ",card_list.data
[i
].token_ptr
);
1887 for
(j
=0;j
<16;j
++) printf
("%d ",card_list.data
[i
].field
[j
]);
1892 @
*Natural Sorting. A natural compare algorithm is used here. It is a
1893 generalization of Martin Pool's algorithm\biblio
{Pool
, Martin. ``Natural
1894 Order String Comparison''.
{\tt
1895 http
://sourcefrog.net
/projects
/natsort
/}.
}.
1897 The \.S table maps from character tokens to the sorting specifications.
1898 Name tokens are converted to |whatsit| when looking up in this table.
1900 Tokens are grouped into digits
, letters
, and priority letters. There are
1901 also some extras
, such as spaces and radix point. A string of consecutive
1902 digits is treated as numeric
, so a number with more digits comes after a
1903 number with less digits.
1905 Priority letters are used mainly for sorting roman numerals. Two or more
1906 consecutive priority letters are considered as a group
, otherwise they are
1907 treated in the same way as ordinary letters. A group is ranked with the
1908 letters latest in the alphabet
, so for example
, if |'I'| and |'
X'| are
1909 priority
, then |
"IX"| is placed between |
"W"| and |
"X"|. This way
, all
1910 roman numerals from I to XXXIX will be sorted correctly.
1919 @d nat_radix_point
4
1921 @d nat_digit_zero
64 // digits go up to
127
1922 @d nat_first_letter
128 // letters go up to
191
1923 @d nat_first_priority_letter
192 // priority letters go up to
255
1924 @d nat_high_value
256
1926 @
<Compare using the card's name and the \.S table@
>= {
1927 token
*pa
=card_areas.data
[set_card_area
(registers
['C'
].number
)].tokens
1929 token
*pb
=card_areas.data
[set_card_area
(registers
['C'
].number
)].tokens
1931 boolean fractional
=0; // Are we reading digits after a radix point?
1934 begin_natural_compare_loop
: @
/
1935 a
=tables
['S'
][*pa
>=256?whatsit
:*pa
];
1936 @
+ b
=tables
['S'
][*pb
>=256?whatsit
:*pb
];
1937 @
<Skip over leading spaces and
/or zeros@
>;
1938 @
<Process a run of digits@
>;
1939 @
<Check if the end of either string is reached@
>;
1940 @
<Check for a radix point@
>;
1941 @
<Process priority letters@
>;
1942 @
<Check if the current positions of each string sufficiently differ@
>;
1946 @ @
<Skip over leading spaces and
/or zeros@
>= {
1947 while
(a
==nat_space||a
==nat_ignore||
(!fractional
&&a==nat_digit_zero)) {
1948 int aa
=tables
['S'
][pa
[1]>=256?whatsit
:pa
[1]];
1949 if
(a
!=nat_ignore
) fractional
=0;
1950 if
(!fractional
&& a==nat_digit_zero
1951 && aa>=nat_digit_zero && aa<nat_first_letter) break;
1952 pa
++; @
+ a
=tables
['S'
][*pa
>=256?whatsit
:*pa
];
1954 while
(b
==nat_space||b
==nat_ignore||
(!fractional
&&b==nat_digit_zero)) {
1955 int bb
=tables
['S'
][pa
[1]>=256?whatsit
:pa
[1]];
1956 if
(b
!=nat_ignore
) fractional
=0;
1957 if
(!fractional
&& b==nat_digit_zero
1958 && bb>=nat_digit_zero && bb<nat_first_letter) break;
1959 pb
++; @
+ b
=tables
['S'
][*pb
>=256?whatsit
:*pb
];
1963 @ @
<Process a run of digits@
>= {
1964 if
(a
>=nat_digit_zero
&&a<nat_first_letter&&
1965 b
>=nat_digit_zero
&&b<nat_first_letter) {
1966 if
((c
=(fractional?compare_left
:compare_right
)(pa
,pb
))) return c
;
1967 @
<Skip the run of digits
, since they are the same@
>;
1973 @ Compare two left-aligned numbers
: the first to have a different value
1974 wins. This function and |compare_right| are basically equivalent
, there
1975 are only a few differences
(this one is the simpler one
).
1977 @
-p int compare_left
(token
*pa
,token
*pb
) {
1980 a
=tables
['S'
][*pa
>=256?whatsit
:*pa
];
1981 @
+ b
=tables
['S'
][*pb
>=256?whatsit
:*pb
];
1982 @
<Skip over ignored characters@
>;
1983 @
<If neither |a| nor |b| is digit
, |break|@
>;
1984 @
<If one is a digit and the other isn't
, the longest run wins@
>;
1985 @
<If both are different digits
, the greater one wins@
>;
1990 @ The longest run of digits wins. That aside
, the greatest value wins
, but
1991 we can't know that it will until we've scanned both numbers to know they
1992 have the same magnitude
, so we remember it in |bias|.
1994 @
-p int compare_right
(token
*pa
,token
*pb
) {
1998 a
=tables
['S'
][*pa
>=256?whatsit
:*pa
];
1999 @
+ b
=tables
['S'
][*pb
>=256?whatsit
:*pb
];
2000 @
<Skip over ignored characters@
>;
2001 @
<If neither |a| nor |b| is digit
, |break|@
>;
2002 @
<If one is a digit and the other isn't
, the longest run wins@
>;
2003 @
<If both are digits
, set the |bias|@
>;
2008 @ Ignored characters might be commas for grouping digits into thousands.
2010 @
<Skip over ignored characters@
>= {
2011 while
(a
==nat_ignore
) {
2012 pa
++; @
+ a
=tables
['S'
][*pa
>=256?whatsit
:*pa
];
2014 while
(b
==nat_ignore
) {
2015 pb
++; @
+ b
=tables
['S'
][*pb
>=256?whatsit
:*pb
];
2019 @ @
<If neither |a| nor |b| is digit
, |break|@
>= {
2020 if
(!(a
>=nat_digit_zero
&&a<nat_first_letter)&&
2021 !(b
>=nat_digit_zero
&&b<nat_first_letter)) break;
2024 @ @
<If one is a digit and the other isn't
, the longest run wins@
>= {
2025 if
(!(a
>=nat_digit_zero
&&a<nat_first_letter)) return -1;
2026 if
(!(b
>=nat_digit_zero
&&b<nat_first_letter)) return 1;
2029 @ @
<If both are different digits
, the greater one wins@
>= {
2030 if
(a
!=b
) return a-b
;
2033 @ @
<If both are digits
, set the |bias|@
>= {
2034 if
(a
!=b
&& !bias) bias=(a<b)?-1:1;
2037 @ @
<Skip the run of digits
, since they are the same@
>= {
2038 while
(a
>=nat_digit_zero
&&a<nat_first_letter) {
2039 pa
++; @
+ pb
++; @
+ a
=tables
['S'
][*pa
>=256?whatsit
:*pa
];
2041 b
=tables
['S'
][*pb
>=256?whatsit
:*pb
];
2044 @ @
<Check if the end of either string is reached@
>= {
2045 if
(a
==nat_end_low
&& b>nat_end_high) return -1;
2046 if
(b
==nat_end_low
&& a>nat_end_high) return 1;
2047 if
(a
==nat_end_high
&& b>nat_end_high) return 1;
2048 if
(b
==nat_end_high
&& a>nat_end_high) return -1;
2049 if
(a
<=nat_end_high
&& b<=nat_end_high) break; // tied
2052 @ A radix point must be followed by a digit
, otherwise it is considered to
2053 be punctuation
(and ignored
). Radix points come before digits in the
2054 sorting order
(|
".5"| comes before |
"5"|
).
2056 @
<Check for a radix point@
>= {
2057 if
(a
==nat_radix_point
&& b==nat_radix_point) {
2058 int aa
=tables
['S'
][pa
[1]>=256?whatsit
:pa
[1]];
2059 int bb
=tables
['S'
][pb
[1]>=256?whatsit
:pb
[1]];
2060 if
(aa
>=nat_digit_zero
&&aa<nat_first_letter
2061 &&bb>=nat_digit_zero&&bb<nat_first_letter) fractional=1;
2062 } @
+else if
(a
==nat_radix_point
) {
2063 int aa
=tables
['S'
][pa
[1]>=256?whatsit
:pa
[1]];
2064 if
(!(aa
>=nat_digit_zero
&&aa<nat_first_letter)) {
2065 pa
++; goto begin_natural_compare_loop
;
2067 } @
+else if
(b
==nat_radix_point
) {
2068 int bb
=tables
['S'
][pb
[1]>=256?whatsit
:pb
[1]];
2069 if
(!(bb
>=nat_digit_zero
&&bb<nat_first_letter)) {
2070 pb
++; goto begin_natural_compare_loop
;
2075 @ This is used so that |
"IX"| can be sorted between |
"VIII"| and |
"X"|. In
2076 normal alphabetical order
, |
"IX"| sorts before |
"V"|. This algorithm makes
2077 it so that doesn't happen. For example
: |a| is |'I'| and |aa|
(the
2078 character after |a| in the text
) is |'
X'|
(the check |aa
>a| ensures that
2079 it too is priority
, in addition to checking that |a| represents a negative
2080 part of a roman number
), and |b| is |'V'|. Now
, since |'V'| comes between
2081 |'I'| and |'
X'| in the alphabetical order
, the condition is checked to be
2082 valid and it overrides the later check.
2084 @
<Process priority letters@
>= {
2085 if
(a
>=nat_first_priority_letter
) {
2086 int aa
=tables
['S'
][pa
[1]>=256?whatsit
:pa
[1]];
2087 if
(aa
>a
&& b>=nat_first_letter && (b&63)>(a&63) && (b&63)<(aa&63))
2090 if
(b
>=nat_first_priority_letter
) {
2091 int bb
=tables
['S'
][pb
[1]>=256?whatsit
:pb
[1]];
2092 if
(bb
>b
&& a>=nat_first_letter && (a&63)>(b&63) && (a&63)<(bb&63))
2097 @ At this point
, |a| and |b| will both be |@
[@
]>=nat_radix_point|. Numbers
2098 always come after letters
(this rule is designed so that when a radix
2099 point is found after a number
, it will make a larger number
; otherwise it
2100 will be followed by a letter and therefore the one followed by the letter
2101 is lesser since it has no fractional part to make it greater
).
2103 @
<Check if the current positions of each string suffic...@
>= {
2104 if
(a
>=nat_first_priority_letter
) a-
=64;
2105 if
(b
>=nat_first_priority_letter
) b-
=64;
2106 if
(a
<nat_first_letter
) a
+=128;
2107 if
(b
<nat_first_letter
) b
+=128;
2108 if
(a
!=b
) return
(a
<b
)?
-1:1;
2111 @
*Statistics. After the card lists are created and sorted and grouped
, it
2112 can make statistics from them. It can be just a plain list
, or it can be
2113 in summary of groups
, measuring count
, minimum
, maximum
, mean
, median
, and
2116 First we do the simple iteration.
2124 @
<Cases for system commands@
>=
2126 // Iterate the card list
2128 char
*q
=pop_string
();
2129 if
(!stack_ptr
[1].is_string
) program_error
("Type mismatch");
2130 foreach
(i
,card_list
) {
2131 push_num
(card_list.data
[i
].token_ptr
);
2139 // Read a field from the card list
2143 foreach
(i
,card_list
) {
2144 if
(registers
['A'
].number
==card_list.data
[i
].token_ptr
)
2145 y
=card_list.data
[i
].field
[x
];
2151 @ That was simple
, see? Now to do gathering statistics of summary of
2152 groups
, which is a bit more complicated. The list is expected to be sorted
2153 by the group field primary
, and the statistics field ascending as
2154 secondary
, in order to make the correct calculation of the fields.
2156 @
<Cases for system commands@
>=
2158 // Gather statistics of groups
2160 int x
=pop_num
()&31; // field for grouping
2161 int y
=pop_num
()&31; // field to measure statistics with
2162 int sum1
,sum2
; // running totals of $s_1$ and $s_2$
2164 char
*q
=pop_string
(); // code to execute for each group
2165 if
(!stack_ptr
[1].is_string
) program_error
("Type mismatch");
2166 foreach
(i
,card_list
) {
2167 if
(card_list.data
[i
].field
[x
]!=card_list.data
[si
].field
[x
]) {
2168 @
<Send the results of the current group@
>;
2169 sum1
=sum2
=0; @
+ si
=i
;
2171 @
<Add to the running totals@
>;
2173 @
<Send the results of the current group@
>;
2178 @ Running totals are kept for two quantities called $s_1$ and $s_2$. There
2179 is also $s_0$
, but that can be calculated easily using subtraction
, so
2180 there is no need to keep a running total. If the sample values are denoted
2181 $x_k$
, the following equation represents the running totals
:
2182 $$s_j
=\sum_
{k
=1}^N
{x_k^j
}$$
(note that $s_0
=N$.
)
2186 @
<Add to the running totals@
>= {
2187 sum1
+=card_list.data
[i
].field
[y
];
2188 sum2
+=card_list.data
[i
].field
[y
]*card_list.data
[i
].field
[y
];
2191 @ Now we will send the results and call |q|. The results are sent to the
2192 stack in the following order
: $s_0$
, $s_1$
, $s_2$
, $Q_0$
, $
2Q_2$
, $Q_4$
2193 (where $Q_0$ is the minimum
, $Q_2$ the median
, and $Q_4$ the maximum
).
2195 From these results
, it is then possible to calculate the standard
2196 deviation
: $$\sigma
={1\over s_0
}\sqrt
{s_0s_2-s_1^
2}$$ and
2197 $$s
=\sqrt
{s_0s_2-s_1^
2\over s_0
(s_0-1
)}.$$
2201 @
<Send the results of the current group@
>= {
2202 push_num
(i-si
); // $s_0$
2203 push_num
(sum1
); // $s_1$
2204 push_num
(sum2
); // $s_2$
2205 push_num
(card_list.data
[si
].field
[y
]); // $Q_0$
2207 card_list.data
[(si
+i
)/2].field
[y
]+card_list.data
[(si
+i
+1)/2].field
[y
]
2209 push_num
(card_list.data
[i-1
].field
[y
]); // $Q_4$
2210 @# push_num
(card_list.data
[si
].token_ptr
); @
+ store
('A'
);
2214 @
*Random Pack Generation. Now the codes so that it can create random packs
2215 (such as booster packs
) by using the card lists and deck lists.
2217 A command |'P'| is used for evaluation of a deck list. It expects the deck
2218 list number and the code to execute for each card on the list.
2222 @
<Cases for system commands@
>=
2224 // Generate a random pack or deck
2225 data_index s
=set_deck_list
(pop_num
());
2226 data_index n
; // current deck list entry
2227 if
(stack_ptr
[1].is_string
) program_error
("Number expected");
2228 @
<Figure out what cards belong in the pack@
>;
2229 @
<Execute the code on the stack for each card in the pack@
>;
2233 @ @
<Figure out what cards belong in the pack@
>= {
2235 int tries
=1000; // How many times can you retry if it fails?
2237 if
(!--tries
) program_error
("No cards matched the deck criteria");
2239 @
<Reset |amount_in_pack| of each card to zero@
>;
2240 while
(n
!=none
&& (n=(e=deck_lists.data+n)->next)!=none)
2241 @
<Process this deck entry@
>;
2244 @ @
<Reset |amount_in_pack| of each card to zero@
>= {
2246 foreach
(i
,card_list
) card_list.data
[i
].amount_in_pack
=0;
2249 @ The deck entry must be processed according to the flags. Here is a list
2252 \.a
: Use all cards that meet the criteria
, instead of only one. If this is
2253 the case
, it is possible to use negative weights to remove cards from the
2254 pack. Also
, it cannot fail.
2255 [Combine with \.
{x
}]
2257 \.k
: Select without replacement. It is fail if the total weight is not
2258 enough. There are two ways in which this differs from \.u
(below
). One is
2259 that the previous lines in the deck list are not used. The other one is
2260 that if the weight is more than one
, there will be more than one ball for
2261 that card
, therefore the same card can be picked up multiple times.
2262 [Combine with \.
{sux
}]
2264 \.n
: Use the |amount| as a probability. If |amount
<=100| then the
2265 probability is |amount
/100| otherwise it is |
100/amount|. This is a
2266 probability of using the |name| to select another deck list instead of
2268 [Combine with nothing
]
2270 \.s
: Skip the next line if this line does not fail.
(Normally
, if one line
2271 fails
, everything does
, and you have to try again.
)
2272 [Combine with \.
{kux
}]
2274 \.u
: Require unique selection. It is fail if the card is already in this
2276 [Combine with \.
{ksx
}]
2278 \.x
: Pass the |name| as a string to the code in the \.U register
, and then
2279 use the resulting code as the code to determine weights instead of using
2280 the code in the register named by |name| directly. Now you can type things
2281 such as |
"12x Forest"| into your deck list.
2282 [Combine with \.
{aksu
}]
2284 @
<Process this deck entry@
>= {
2285 if
(e-
>flags
&lflag('n')) {
2286 @
<Determine whether or not to skip to another deck list@
>;
2288 char
*c
; // code for weights of each card
2289 int total
; // total weight of cards
2290 data_index
*bag
=malloc
(sizeof
(data_index
));
2291 @
<Get the code |c| for the weights of each card@
>;
2292 @
<Calculate the weights of each card@
>;
2293 if
(!(e-
>flags
&lflag('a')))
2294 @
<Select some of the cards at random and add them to the pack@
>;
2295 if
(e-
>flags
&lflag('x')) free(c);
2300 @ @
<Determine whether or not to skip to another deck list@
>= {
2302 if
(e-
>amount
<=100) {
2303 q
=(gen_random
(100)<e-
>amount
);
2305 q
=(100<gen_random
(e-
>amount
));
2307 if
(q
) n
=set_deck_list
(find_name
(e-
>name
));
2310 @ @
<Get the code |c| for the weights of each card@
>= {
2311 if
(e-
>flags
&lflag('x')) {
2312 execute_program
(registers
['U'
].text
);
2313 if
(stack_ptr-
>is_string
) {
2316 program_error
("Type mismatch");
2319 int n
=find_name
(e-
>name
);
2320 if
(name_info
(n
).value.is_string
) {
2321 c
=name_info
(n
).value.text
;
2323 program_error
("Type mismatch");
2328 @ @
<Calculate the weights of each card@
>= {
2330 foreach
(i
,card_list
) {
2331 registers
['A'
].number
=card_list.data
[i
].token_ptr
;
2333 if
(stack_ptr-
>number
) {
2334 if
(e-
>flags
&lflag('a')) {
2335 card_list.data
[i
].amount_in_pack
+=e-
>amount
*stack_ptr-
>number
;
2336 } @
+else if
(stack_ptr-
>number
>0) {
2337 @
<Add the cards to the |bag|@
>;
2344 @ The |bag| is like
, you put the balls in the bag so that you can mix it
2345 and take one out
, whatever number is on the ball is the card you put into
2346 the pack. Except
, that there is no balls and no bag.
2348 There is one ball per point of weight.
2352 @
<Add the cards to the |bag|@
>= {
2353 int j
=stack_ptr-
>number
;
2354 bag
=realloc
(bag
,(total
+j
)*sizeof
(data_index
));
2355 while
(j--
) bag
[total
+j
]=i
;
2356 total
+=stack_ptr-
>number
;
2359 @ If it is not a line which adds all possibilities at once
, then the cards
2360 must be selected from the |bag| at random to bag them. In some cases it
2363 @
<Select some of the cards at random and add them to the pack@
>= {
2365 int amount
=e-
>amount
;
2367 if
(!total
) @
<Deal with bag failure@
>;
2368 r
=gen_random
(total
);
2369 if
((e-
>flags
&lflag('u')) && card_list.data[bag[r]].amount_in_pack) {
2370 bag
[r
]=bag
[--total
];
2373 card_list.data
[bag
[r
]].amount_in_pack
++;
2374 if
(e-
>flags
&lflag('k')) bag[r]=bag[--total];
2375 if
(amount--
) goto bag_next
;
2376 @#if
(e-
>flags
&lflag('s')) n=deck_lists.data[n].next;
2380 @ @
<Deal with bag failure@
>= {
2381 if
(e-
>flags
&lflag('s')) goto bag_done;
2382 else goto figure_out_again
;
2385 @ Now it must do stuff using the list which is generated. The quantity for
2386 how many of that card is pushed on the stack
, and this is done even for
2387 cards with negative quantity
(but not for zero quantity
).
2389 @
<Execute the code on the stack for each card in the pack@
>= {
2391 char
*q
=pop_string
();
2392 if
(!stack_ptr
[1].is_string
) program_error
("Type mismatch");
2393 foreach
(i
,card_list
) {
2394 if
(card_list.data
[i
].amount_in_pack
) {
2395 push_num
(card_list.data
[i
].amount_in_pack
);
2402 @
*Reading Input Files. Now it is time for the part of the program where
2403 input files are read and processed. The areas of the file
(and other
2404 special commands
) are indicated using \.@@ signs.
2406 At first we have state information. Each state is labeled by uppercase
2407 letters
, or by digits
1 to
9. The high bit is set for the heading state
,
2408 meaning the first line that contains the name and
/or other heading
2414 @d execute_state 'E'
2416 @d include_state 'I'
2417 @d keyword_state 'K'
2418 @d pattern_state 'P'
2419 @d subroutine_state 'S'
2420 @d wordforms_state 'W'
2423 @
<Global variables@
>=
2425 data_index cur_name
;
2426 data_index cur_data
;
2427 boolean omit_line_break
;
2429 @ The next thing that must be kept track of for input files is the stack
2430 of open input files.
2432 @d max_pathname_length
128
2433 @d max_filename_length
128
2434 @d max_input_stack
128
2435 @d max_line_length
256
2439 FILE*fp
; // zero for terminal input
2440 char name
[max_filename_length
+1];
2444 @ @
<Global variables@
>=
2445 input_file_data input_files
[max_input_stack
];
2446 input_file_data
*current_input_file
=input_files
;
2447 char input_buffer
[max_line_length
];
2449 @ Some macros are useful to access the current file data.
2451 @d current_line
(current_input_file-
>line
)
2452 @d current_filename
(current_input_file-
>name
)
2453 @d current_fp
(current_input_file-
>fp
)
2455 @d parsing_error
(_text
) fprintf
(stderr
,"%s on line %d in %s\n",
2456 _text
,current_line
,current_filename
)@
;
2458 @ There is also conditional processing directives
, which uses a single
2459 variable to keep track of the level. If it is greater than zero
, the
2460 condition is false
, and it is increased for nesting conditions
(the
2461 nested conditions have no truth to them
).
2463 @
<Global variables@
>=
2464 int condition_level
=0;
2466 @ This subroutine inputs the next line. True is returned if there is a
2467 line
, or false if it is finished.
2469 It is necessary to check for end of file and if so
, close that file and
2470 try the one it was included from
; and if it is terminal input
, display the
2471 current state when prompting input from the user.
2473 @
-p boolean input_line
(void
) {
2474 input_line_again
: if
(current_fp
) {
2475 @
<Get a line of input from the file@
>;
2477 @
<Get a line of terminal input@
>;
2479 @
<Remove trailing |'\n'|
, |'\r'|
, and spaces@
>;
2484 @ @
<Get a line of input from the file@
>= {
2485 if
(!fgets
(input_buffer
,max_line_length
,current_fp
)) {
2486 memusage_log
("Closing input file",current_input_file-input_files
)@
;
2488 if
(current_input_file
>input_files
) {
2489 --current_input_file
;
2490 goto input_line_again
;
2497 @ @
<Get a line of terminal input@
>= {
2498 printf
("\n%c> ",cur_state?cur_state
:'
>'
);
2500 if
(!fgets
(input_buffer
,max_line_length
,stdin
)) return
0;
2503 @ This function is used in order to open another input file. One way is
2504 that the file might be included from another file
, or it might be the
2507 @
-p void open_input
(char
*name
) {
2508 if
(++current_input_file
>input_files
+max_input_stack
) {
2509 fprintf
(stderr
,"Too many simultaneous input files\n");
2512 memusage_log
("Opening input file",current_input_file-input_files
)@
;
2513 strcpy
(current_filename
,name
);
2515 current_fp
=fopen
(name
,"r");
2517 fprintf
(stderr
,"Cannot open input file: %s\n",name
);
2522 @ Trailing newlines and spaces are removed. On some computers
, there will
2523 be a carriage return before the line feed
, it should be removed
, so that
2524 the same file will work on other computers
, too.
2526 @d last_character_input input_buffer
[strlen
(input_buffer
)-1]
2528 @
<Remove trailing |'\n'|
, |'\r'|
, and spaces@
>= {
2529 if
(last_character_input
=='\n'
) last_character_input
=0;
2530 if
(last_character_input
=='\r'
) last_character_input
=0;
2531 while
(last_character_input
==' '
) last_character_input
=0;
2534 @ The input states start at these values.
2536 @
<Initialize the input states@
>= {
2537 cur_state
=execute_state
;
2538 cur_name
=cur_data
=0;
2541 @ Now it is the time to do the actual processing according to the contents
2542 of the lines of the file. A line starting with \.@@ sign will indicate a
2543 special command
(to operate in all modes
) or a mode switch command.
2545 @d delete_chars
(_buf
,_c
) memmove
((_buf
),(_buf
)+(_c
),strlen
((_buf
)+(_c
))+1)
2547 @
<Process the input files@
>= {
2549 while
(input_line
()) {
2551 if
(condition_level
) {
2552 buf
+=strspn
(buf
," ");
2553 condition_level
+=!strcmp
(buf
,"@@<");
2554 condition_level-
=!strcmp
(buf
,"@@>");
2557 @
<Convert \.@@ commands in the |input_buffer|@
>;
2564 @ @
<Convert \.@@ commands in the |input_buffer|@
>= {
2565 char
*ptr
=input_buffer
;
2568 @
<Convert the current \.@@ command@
>;
2575 @ @
<Convert the current \.@@ command@
>= {
2578 delete_chars
(ptr
,1);
2580 case '.'
: @
<Process \.
{@@.
} command@
>;@
+break
;
2581 case '
&': @<Process \.{@@\&} command@>;@+break;
2582 case '^'
: @
<Process \.
{@@\^
} command@
>;@
+break
;
2583 case '
('
: @
<Process \.
{@@
(} command@
>;@
+break
;
2584 case '
<'
: @
<Process \.
{@@
<} command@
>;@
+break
;
2585 case '
>'
: /* Do nothing
*/ @
+break
;
2587 if
((*ptr
>='A'
&& *ptr<='Z') || (*ptr>='0' && *ptr<='9')) {
2588 @
<Enter a |heading| state@
>;
2590 parsing_error
("Unknown @@ command");
2595 @ Heading states are used for the first line of a section in the file.
2596 After that line is processed
, it becomes the corresponding non-heading
2597 state |
(cur_state
&~heading)|.
2599 Note
: The state |'
0'| is deliberately unused
; you might use it for
2600 documentation areas
, for example.
2602 @^documentation areas@
>
2604 @
<Enter a |heading| state@
>= {
2605 cur_state
=heading|
*ptr--
;
2606 delete_chars
(ptr
,2);
2607 while
(*ptr
==' ' ||
*ptr
=='\t'
) delete_chars
(ptr
,1);
2610 @ @
-p void process_line
(char
*buf
) {
2612 cur_state
&=~heading;
2614 case card_state
: @
<Process card state@
>;@
+break
;
2615 case deck_state
: @
<Process deck state@
>;@
+break
;
2616 case execute_state
: @
<Process execute state@
>;@
+break
;
2617 case file_state
: @
<Process file state@
>;@
+break
;
2618 case keyword_state
: @
<Process keyword state@
>;@
+break
;
2619 case pattern_state
: @
<Process pattern state@
>;@
+break
;
2620 case subroutine_state
: @
<Process subroutine state@
>;@
+break
;
2621 case wordforms_state
: @
<Process word forms state@
>;@
+break
;
2622 case card_state|heading
: @
<Process card heading@
>;@
+break
;
2623 case deck_state|heading
: @
<Process deck heading@
>;@
+break
;
2624 case file_state|heading
: @
<Process file heading@
>;@
+break
;
2625 case include_state|heading
: @
<Process include heading@
>;@
+break
;
2626 case keyword_state|heading
: @
<Process keyword heading@
>;@
+break
;
2627 case pattern_state|heading
: @
<Process pattern heading@
>;@
+break
;
2628 case subroutine_state|heading
: @
<Process subroutine heading@
>;@
+break
;
2629 default
: ; // nothing happens
2633 @ Sometimes you might want a macro which can send a line programmatically.
2634 So
, here is the way that it is done.
2636 @
<Cases for system commands@
>=
2638 // Process a line by programming
2639 if
(stack_ptr-
>is_string
) program_error
("Type mismatch");
2640 cur_state
=pop_num
()|heading
;
2641 if
(!stack_ptr-
>is_string
) program_error
("Type mismatch");
2643 process_line
(stack_ptr-
>text
);
2648 @
*Inner Commands. These are commands other than the section headings.
2650 @ The first command to deal with is simple--it is a comment. The rest of
2651 the current line is simply discarded.
2653 @
<Process \.
{@@.
} command@
>= {
2657 @ This command is a pattern split. It means it will process the part of
2658 the line before this command and then process the stuff after it. The
2659 variable |omit_line_break| is
1 if this command is used
; because it means
2660 there will not be a line break.
(Otherwise
, patterns and so on are split
2663 @
<Process \.
{@@\
&} command@>= {
2669 @ This allows control characters to be inserted into the input. This code
2670 takes advantage of the way the ASCII code works
, in which stripping all
2671 but the five low bits can convert a letter
(uppercase or lowercase
) to its
2672 corresponding control character.
2674 @^control character@
>
2676 @
<Process \.
{@@\^
} command@
>= {
2679 delete_chars
(ptr
,2);
2682 @ The following command is used to execute a code in a different state and
2683 then include the results in this area.
2685 @
<Process \.
{@@
(} command@
>= {
2688 @
<Skip over the name and save the rest of the line@
>;
2689 @
<Execute the code for the named subroutine@
>;
2690 @
<Insert the returned string and fix the line buffer@
>;
2693 @ @
<Skip over the name and save the rest of the line@
>= {
2695 while
(*ptr
&& *ptr!=')') ptr++;
2696 q
=strdup
(ptr
+!!*ptr
);
2700 @ @
<Execute the code for the named subroutine@
>= {
2702 execute_program
(fetch_code
(n
));
2705 @ @
<Insert the returned string and fix the line buffer@
>= {
2706 char
*s
=pop_string
();
2707 sprintf
(p-2
,"%s%s",s
,q
);
2713 @ This command is used for conditional processing. The condition value
2714 comes from the stack. Zero is false
, everything else is true.
2716 @
<Process \.
{@@
<} command@
>= {
2718 delete_chars
(ptr
,2);
2719 condition_level
=!stack_ptr-
>number
;
2723 @
*Card State. Cards are added to the card areas by using the card state.
2724 The \.C register tells which is the current card area
, and \.P register is
2725 used to select the current pattern area. The pattern area is used to match
2726 patterns after reading a line. Please note that it won't work to change
2727 the value of the \.C register during the card state.
2729 @
<Process card heading@
>= {
2730 int n
=find_name
(buf
);
2731 cur_data
=set_card_area
(n
);
2733 push_num
(n
);@
+store
('C'
);
2736 @ @
<Process card state@
>= {
2738 if
(!omit_line_break
) strcpy
(buf
+strlen
(buf
),"\n");
2739 @
<Initialize the \.W register@
>;
2740 b
=do_patterns
(strdup
(buf
),registers
['P'
].number
);
2741 if
(registers
['W'
].is_string
) execute_program
(registers
['W'
].text
);
2742 @
<Send the tokens of |b| and replace whatsits@
>;
2746 @ @
<Initialize the \.W register@
>= {
2747 if
(registers
['W'
].is_string
) free
(registers
['W'
].text
);
2748 registers
['W'
].is_string
=1;
2749 registers
['W'
].text
=strdup
("");
2752 @ @
<Send the tokens of |b| and replace whatsits@
>= {
2756 send_token
(cur_data
,pop_num
());
2758 send_token
(cur_data
,(*p
==1)?
0:*p
);
2763 @ There is one command you might want to send tokens in any other time.
2765 @
<Cases for system commands@
>=
2767 // Add tokens to the card area
2768 if
(stack_ptr-
>is_string
) {
2769 @
<Send tokens from the string on the stack@
>;
2771 send_token
(set_card_area
(registers
['C'
].number
),stack_ptr-
>number
);
2777 @ @
<Send tokens from the string on the stack@
>= {
2779 data_index q
=set_card_area
(registers
['C'
].number
);
2780 for
(p
=stack_ptr-
>text
;*p
;p
++) send_token
(q
,*p
);
2783 @
*Deck State. Deck state is used for creating deck lists and random packs.
2785 @
<Process deck heading@
>= {
2786 cur_name
=find_name
(buf
)-256;
2787 cur_data
=set_deck_list
(cur_name
+256);
2788 @
<Skip to the end of the deck list@
>;
2791 @ @
<Skip to the end of the deck list@
>= {
2792 while
(deck_lists.data
[cur_data
].next
!=none
)
2793 cur_data
=deck_lists.data
[cur_data
].next
;
2796 @ Now to parse each line in turn. Each line consists of a number
, the
2799 @
<Process deck state@
>= {
2800 int n
=strtol
(buf
,&buf,10);
2803 buf
+=strspn
(buf
,"\x20\t");
2804 @
<Read the flags for the deck list@
>;
2805 buf
+=strspn
(buf
,"\x20\t"); // Now we are at the point of the text
2806 @
<Send this line to the deck list@
>;
2807 @
<Create and advance to the new terminator of the deck list@
>;
2811 @ @
<Read the flags for the deck list@
>= {
2812 while
(*buf
>='a'
&& *buf<='z') f |=lflag(*buf++);
2813 buf
++; // Skip terminator of flags
2816 @ If the \.x flag is set
, it will be determined what to do with the text
2817 by the user-defined code. Otherwise
, it is always a name
, so we can save
2818 memory by pointing to the name buffer
(since name buffers never vary
).
2820 @
<Send this line to the deck list@
>= {
2822 deck_lists.data
[cur_data
].name
=strdup
(buf
);
2824 deck_lists.data
[cur_data
].name
=name_info
(find_name
(buf
)).name
;
2828 @ @
<Create and advance to the new terminator of the deck list@
>= {
2829 data_index i
=new_record
(deck_lists
);
2830 deck_lists.data
[cur_data
].next
=i
;
2831 deck_lists.data
[cur_data
=i
].next
=none
;
2834 @
*Execute State. This state is simple
, just execute stack codes. It is the
2835 initial state
; you can use it with terminal input
, too.
2837 @
<Process execute state@
>= {
2838 execute_program
(buf
);
2841 @
*File State. This state is used to make list of output files. Each one is
2842 stored as a string
, like subroutine state. The difference is that newlines
2843 will not be discarded. The other difference is that there is a flag in the
2844 |name_data| record for it that tells it that it is a file that should be
2847 @
<More elements of |name_data|@
>=
2848 boolean is_output_file
;
2850 @ @
<Process file heading@
>= {
2851 cur_name
=find_name
(buf
)-256;
2852 if
(!names.data
[cur_name
].value.is_string
) {
2853 names.data
[cur_name
].value.is_string
=1;
2854 names.data
[cur_name
].value.text
=strdup
("");
2855 names.data
[cur_name
].is_output_file
=1;
2859 @ @
<Process file state@
>= {
2860 int z
=strlen
(names.data
[cur_name
].value.text
);
2861 if
(!omit_line_break
) strcpy
(buf
+strlen
(buf
),"\n");
2862 names.data
[cur_name
].value.text
=realloc
(names.data
[cur_name
].value.text
,
2864 strcpy
(names.data
[cur_name
].value.text
+z
,buf
);
2867 @
*Include State. The include state causes inclusion of another source file
2870 @
<Process include heading@
>= {
2871 cur_state
=execute_state
;
2872 @
<Push the include file onto the input stack@
>;
2873 @
<Attempt to open the include file...@
>;
2876 @ @
<Push the include file onto the input stack@
>= {
2877 ++current_input_file
;
2878 memusage_log
("Opening input file",current_input_file-input_files
)@
;
2879 strcpy
(current_filename
,buf
);
2884 @ Include files are searched using the search path specified in the
2885 environment variable called \.
{TEXNICARDPATH
}, which is a list of paths
2886 delimited by colons on
UNIX systems
(including Cygwin
), but semicolons on
2887 Windows
(colons are used in Windows for drive letters
). A forward slash is
2888 the path separator. Please note that if you want to use include files in
2889 the current directory
, you must include |
"."| as the first entry in the
2896 @
<Set |includepath_separator| depending on operating system@
>=
2898 #define @
!includepath_separator '
;'
2900 #define includepath_separator '
:'
2903 @ @
<Attempt to open the include file by finding it in the search path@
>= {
2904 char searchpath
[max_pathname_length
+max_filename_length
+1];
2906 char
*npath
=getenv
("TEXNICARDPATH");
2907 strcpy
(searchpath
,npath?npath
:".");
2908 npath
=cpath
=searchpath
;
2909 @
<Set |includepath_separator| depending on operating system@
>;
2910 @
<Attempt to open the file from each each directory in the search path@
>;
2911 @
<It is a fatal error if no such file was found@
>;
2914 @ @
<Attempt to open the file from each each directory...@
>= {
2915 while
(!current_fp
) {
2916 char f
[max_pathname_length
+max_filename_length
+1];
2917 @
<Select the next path name into |cpath| and |npath|@
>;
2918 sprintf
(f
,"%s/%s",cpath
,current_filename
);
2919 current_fp
=fopen
(f
,"r");
2923 @ @
<Select the next path name into |cpath| and |npath|@
>= {
2924 if
(!(cpath
=npath
)) break
;
2925 if
((npath
=strchr
(npath
,includepath_separator
))) *npath
++=0;
2928 @ @
<It is a fatal error if no such file was found@
>= {
2930 fprintf
(stderr
,"%s not found in search path.\n",current_filename
);
2935 @
*Keyword State. You can add keywords to the keyword area by using this.
2936 Each keyword heading is one entry in the list.
2938 @
<Process keyword heading@
>= {
2939 cur_data
=new_record
(keywords
);
2940 keywords.data
[cur_data
].match
=strdup
(buf
);
2941 keywords.data
[cur_data
].replacement
=strdup
("");
2944 @ @
<Process keyword state@
>= {
2945 keyword_data
*k
=&keywords.data[cur_data];
2947 k-
>category|
=find_category
(buf
+1);
2949 if
(!omit_line_break
) strcpy
(buf
+strlen
(buf
),"\n");
2950 @
<Append buffer to keyword text@
>;
2954 @ @
<Append buffer to keyword text@
>= {
2956 int z
=strlen
(k-
>replacement
);
2957 k-
>replacement
=realloc
(k-
>replacement
,z
+strlen
(buf
)+1);
2958 strcpy
(k-
>replacement
+z
,buf
);
2962 @
*Pattern State. This state compiles patterns into a pattern area. It
2963 uses its own syntax
, and then is converted into the proper control codes
2964 for the |text| of a pattern.
2966 @
<Process pattern heading@
>= {
2967 cur_name
=find_name
(buf
)-256;
2968 cur_data
=set_pattern_area
(cur_name
+256);
2971 @ The stuff inside the pattern state has its own commands.
2973 @
<Process pattern state@
>= {
2974 char add_buf
[1024]; // buffer of text to add to the current pattern
2975 pattern_data
*pat
=&pattern_areas.data[cur_data];
2978 case '
<'
: @
<Create a new pattern with top priority@
>;@
+break
;
2979 case '
>'
: @
<Create a new pattern with bottom priority@
>;@
+break
;
2980 case '
:'
: @
<Make a pattern text with a marker@
>;@
+break
;
2981 case '
+'
: @
<Add a keyword category to this pattern@
>;@
+break
;
2982 default
: ; // do nothing
2984 @
<Append contents of |add_buf| to the pattern
, if needed@
>;
2987 @ @
<Create a new pattern with top priority@
>= {
2988 cur_data
=new_record
(pattern_areas
);
2989 pattern_areas.data
[cur_data
].text
=strdup
("");
2990 pattern_areas.data
[cur_data
].subroutine
=find_name
(buf
+1)-256;
2991 pattern_areas.data
[cur_data
].next
=names.data
[cur_name
].pattern_area
;
2992 names.data
[cur_name
].pattern_area
=cur_data
;
2995 @ @
<Create a new pattern with bottom priority@
>= {
2997 cur_data
=new_record
(pattern_areas
);
2998 pattern_areas.data
[cur_data
].text
=strdup
("");
2999 pattern_areas.data
[cur_data
].subroutine
=find_name
(buf
+1)-256;
3000 pattern_areas.data
[cur_data
].next
=none
;
3001 @
<Find the bottom pattern and store its index in |n|@
>;
3002 pattern_areas.data
[n
].next
=cur_data
;
3005 @ @
<Find the bottom pattern and...@
>= {
3006 n
=names.data
[cur_name
].pattern_area
;
3007 while
(pattern_areas.data
[n
].next
!=none
&& pattern_areas.data[n].text &&
3008 pattern_areas.data
[pattern_areas.data
[n
].next
].next
!=none
)
3009 n
=pattern_areas.data
[n
].next
;
3012 @ Actually
, the name of this \strike
{cake
} chunk is a lie
, because it does
3013 not always add a marker.
3015 @
<Make a pattern text with a marker@
>= {
3018 @
<Add the pattern marker if applicable@
>;
3019 for
(p
=buf
+2;p
[-1] && *p;p++) {
3021 case '\\'
: *b
++=*++p
; @
+break
;
3022 case '
('
: *b
++=begin_capture
; @
+break
;
3023 case '
)'
: *b
++=end_capture
; @
+break
;
3024 case '
%'
: *b
++=match_keyword
; @
+*b
++=*++p
; @
+break
;
3025 case '
!'
: *b
++=match_table
; @
+*b
++=*++p
; @
+break
;
3026 case '?'
: *b
++=optional_table
; @
+*b
++=*++p
; @
+break
;
3027 case '#'
: *b
++=failed_match
; @
+break
;
3028 case '
&': *b++=jump_table; @+*b++=*++p; @+break;
3029 case '
;'
: *b
++=successful_match
; @
+break
;
3030 case '
<'
: *b
++=back_one_space
; @
+break
;
3031 case '
>'
: *b
++=forward_one_space
; @
+break
;
3032 case '
['
: *b
++=match_left_side
; @
+break
;
3033 case '
]'
: *b
++=match_right_side
; @
+break
;
3034 default
: *b
++=*p
; @
+break
;
3040 @ @
<Add the pattern marker if applicable@
>= {
3041 if
(buf
[1]>' '
) *b
++=buf
[1]|
0x80;
3044 @ @
<Add a keyword category to this pattern@
>= {
3045 pattern_areas.data
[cur_data
].category
=find_category
(buf
+1);
3048 @ @
<Append contents of |add_buf| to the pattern...@
>= {
3050 int z
=strlen
(pat-
>text
);
3051 pat-
>text
=realloc
(pat-
>text
,z
+strlen
(add_buf
)+1);
3052 strcpy
(pat-
>text
+z
,add_buf
);
3056 @
*Subroutine State. This state is used to add a named subroutine.
3058 @
<Process subroutine heading@
>= {
3059 cur_name
=find_name
(buf
)-256;
3060 if
(!names.data
[cur_name
].value.is_string
) {
3061 names.data
[cur_name
].value.is_string
=1;
3062 names.data
[cur_name
].value.text
=strdup
("");
3066 @ @
<Process subroutine state@
>= {
3067 int z
=strlen
(names.data
[cur_name
].value.text
);
3068 names.data
[cur_name
].value.text
=realloc
(names.data
[cur_name
].value.text
,
3070 strcpy
(names.data
[cur_name
].value.text
+z
,buf
);
3073 @
*Word Forms State. You can use the word forms state to enter rules and
3074 exceptions for word forms
, such as plurals.
3076 @
<Global variables@
>=
3077 char wordform_code
[256]; // code to execute at \.
= line
3078 char wordform_kind
; // which kind of word forms is being made now?
3080 @ @
<Process word forms state@
>= {
3082 case '
>'
: @
<Process \.
> line in word forms state@
>; @
+break
;
3083 case '
='
: @
<Process \.
= line in word forms state@
>; @
+break
;
3084 case '#'
: wordform_kind
=buf
[1]; @
+break
;
3085 default
: if
(*buf
>='
0'
&& *buf<='9')
3086 @
<Process numeric line in word forms state@
>;
3090 @ The commands are \.
>, \.
=, and numbers. The command \.
> sets a code for
3091 processing \.
= commands
, and then add to the list.
3093 @
<Process \.
> line in word forms state@
>= {
3094 strcpy
(wordform_code
,buf
+1);
3097 @ @
<Process \.
= line in word forms state@
>= {
3102 execute_program
(wordform_code
);
3103 kind
=pop_num
(); @
+ level
=pop_num
();
3104 dest
=pop_string
(); @
+ orig
=pop_string
();
3105 add_word_form
(kind
,level
,orig
,dest
);
3106 free
(orig
); @
+ free
(dest
);
3109 @ Now the command for numeric forms. You put ``level\.
:orig\.
:dest'' in
3112 @
<Process numeric line in word forms state@
>= {
3113 int level
=strtol
(buf
,&buf,0);
3115 if
(*buf
=='
:'
) buf
++;
3118 add_word_form
(wordform_kind
,level
,buf
,p
+1);
3121 @
*Writing Output Files. Finally
, it will be time to send any output
3122 generated into the files
(if there is any
, which there usually is
).
3126 @d ctrl
(_letter
) (0x1F&(_letter))
3128 @d call_final_subroutine ctrl
('C'
)
3129 @d copy_field ctrl
('F'
)
3130 @d newline ctrl
('J'
)
3131 @d loop_point ctrl
('L'
)
3132 @d next_record ctrl
('N'
)
3133 @d skip_one_character ctrl
('S'
)
3135 @
<Write the output files@
>= {
3138 if
(names.data
[n
].is_output_file
&& names.data[n].value.is_string)
3139 @
<Write this output file@
>;
3143 @ @
<Write this output file@
>= {
3144 FILE*fout
=fopen
(names.data
[n
].name
,"w");
3145 char
*ptr
=names.data
[n
].value.text
;
3146 char
*loopptr
=ptr
; // loop point
3147 if
(!fout
) @
<Error about unable to open output file@
>;
3148 while
(*ptr
) @
<Write the character and advance to the next one@
>;
3152 @ @
<Error about unable to open output file@
>= {
3153 fprintf
(stderr
,"Unable to open output file: %s\n",names.data
[n
].name
);
3157 @ @
<Write the character and advance to the next one@
>= {
3159 case call_final_subroutine
: @
<Do |call_final_subroutine|@
>; @
+break
;
3160 case copy_field
: @
<Do |copy_field|@
>; @
+break
;
3161 case loop_point
: loopptr
=++ptr
; @
+break
;
3162 case next_record
: @
<Do |next_record|@
>; @
+break
;
3163 case skip_one_character
: ptr
+=2; @
+break
;
3164 default
: fputc
(*ptr
++,fout
);
3166 done_writing_one_character
: ;
3169 @ @
<Do |call_final_subroutine|@
>= {
3172 char
*p
=strchr
(ptr
,'
)'
);
3174 v
=&name_info(find_name(ptr+1)).value;
3178 v
=®isters[*ptr++];
3181 execute_program
(v-
>text
);
3182 @
<Write or loop based on result of subroutine call@
>;
3187 @ @
<Write or loop based on result of subroutine call@
>= {
3188 if
(stack_ptr-
>is_string
) {
3189 fprintf
(fout
,"%s",stack_ptr-
>text
);
3190 } @
+else if
(stack_ptr-
>number
) {
3195 @ This command is used to copy the next field.
3197 Look at the definition for the |send_reg_char_or_text| macro. It is
3198 strange
, but it should work wherever a statement is expected. Please note
3199 that a ternary condition operator should have both choices of the same
3204 @d tok_idx
(registers
['A'
].number
)
3206 (card_areas.data
[name_info
(registers
['C'
].number
).value.number
].tokens
)
3208 @d send_reg_char_or_text
(_reg
)
3209 if
(!registers
[_reg
].is_string ||
*registers
[_reg
].text
)
3210 fprintf
(fout
, "%c%s",
3211 registers
[_reg
].is_string?
3212 *registers
[_reg
].text
:registers
[_reg
].number
,
3213 registers
[_reg
].is_string?
3214 registers
[_reg
].text
+1:(unsigned char
*)""
3217 @
<Do |copy_field|@
>= {
3220 switch
(tok_area
[tok_idx
++]) {
3221 case null_char
: @
<Unexpected |null_char|@
>;
3222 case end_transmission
: tok_idx
=0; @
+goto done_writing_one_character
;
3223 case tabulation
: send_reg_char_or_text
('T'
); @
+break
;
3224 case raw_data
: @
<Do |raw_data|@
>; @
+break
;
3225 case escape_code
: send_reg_char_or_text
('E'
); @
+break
;
3226 case record_separator
: tok_idx--
; @
+goto done_writing_one_character
;
3227 case field_separator
: @
+goto done_writing_one_character
;
3229 if
(tok_area
[--tok_idx
]&~0xFF)
3230 @
<Deal with name code@
>@
;
3232 @
<Deal with normal character@
>;
3238 @ @
<Unexpected |null_char|@
>= {
3239 fprintf
(stderr
,"Unexpected null character found in a card area\n");
3243 @ @
<Do |raw_data|@
>= {
3244 while
(tok_area
[tok_idx
]) fputc
(tok_area
[tok_idx
++],fout
);
3248 @ A name code found here is a code to tell it to call the subroutine code
3249 when it is time to write it out to the file. It should return a string on
3250 the stack
(if it is a number
, it will be ignored
).
3252 @
<Deal with name code@
>= {
3253 if
(name_info
(tok_area
[tok_idx
]).value.is_string
)
3254 execute_program
(name_info
(tok_area
[tok_idx
]).value.text
);
3255 if
(stack_ptr-
>is_string
) fprintf
(fout
,"%s",stack_ptr-
>text
);
3259 @ In case of a normal character
, normally just write it out. But some
3260 characters need escaped for \TeX.
3262 @
<Deal with normal character@
>= {
3263 if
(tables
['E'
][tok_area
[tok_idx
]]) send_reg_char_or_text
('E'
);
3264 fputc
(tok_area
[tok_idx
],fout
);
3267 @ This one moves to the next record
, looping if a next record is in fact
3268 available. Otherwise
, just continue. Note that a |record_separator|
3269 immediately followed by a |end_transmission| is assumed to mean there is
3270 no next record
, and that there is allowed to be a optional
3271 |record_separator| just before the |end_transmission|.
3273 @
<Do |next_record|@
>= {
3275 while
(tok_area
[tok_idx
]!=record_separator
&&
3276 tok_area
[tok_idx
]!=end_transmission
) tok_idx
++;
3277 if
(tok_area
[tok_idx
]!=end_transmission
&&
3278 tok_area
[tok_idx
+1]!=end_transmission
) ptr
=loopptr
;
3281 @
*Functions Common to DVI and GF. Numbers for \.
{GF
} and \.
{DVI
} files use
3282 the |dvi_number| data type.
(Change this in the change file if the current
3283 setting is inappropriate for your system.
)
3285 There is also the |dvi_measure| type
, which is twice as long and is used
3286 to compute numbers that can be fractional
(with thirty-two fractional bits
3287 and thirty-two normal bits
).
3290 @q
[Type of DVI numbers
::]@
>
3291 typedef signed int dvi_number
;
3292 typedef signed long long int dvi_measure
;
3293 @q
[::Type of DVI numbers
]@
>
3295 @ There is one subroutine here to read a |dvi_number| from a file. They
3296 come in different sizes and some are signed and some are unsigned.
3301 @
-p dvi_number get_dvi_number
(FILE*fp
,boolean is_signed
,int size
) {
3302 dvi_number r
=is_signed?
-1:0;
3303 while
(size--
) r
=(r
<<8)|fgetc
(fp
);
3307 @ Some macros are defined here in order to deal with |dvi_measure| values.
3311 @d to_measure
(_value
) (((dvi_measure
)(_value
))<<32)
3312 @d floor
(_value
) ((dvi_number
)((_value
)>>32))
3313 @d round
(_value
) ((dvi_number
)(((_value
)+0x8000)>>32))
3314 @d ceiling
(_value
) ((dvi_number
)(((_value
)+0xFFFF)>>32))
3315 @d make_fraction
(_n
,_d
) ((dvi_measure
)(to_measure
(_n
)/(_d
)))
3319 At first
, names will be given for the commands in a \.
{GF
} file. Many
3320 commands have the same numbers as they do in a \.
{DVI
} file
(described in
3321 the next chapter
), which makes it very convenient.
3323 @d paint_0
0 // Paint $d$ pixels black or white
[up to
63]
3324 @d paint1
64 // Take parameter
, paint pixels
[up to
66]
3325 @d boc
67 // Beginning of a character picture
3326 @d boc1
68 // Short form of |boc|
3327 @d eoc
69 // End of a character picture
3328 @d skip0
70 // Skip some rows
[up to
73]
3329 @d new_row_0
74 // Start a new row and move right
[up to
238]
3330 @d yyy
243 // Numeric specials
3331 @d no_op
244 // No operation
3332 @d char_loc
245 // Character locator
3333 @d char_loc0
246 // Short form of |char_loc|
3335 @
*DVI Reading. The device-independent file format is a format invented by
3336 David R.~Fuchs in
1979. The file format need not be explained here
, since
3337 there are other books which explain it\biblio
{Knuth
, Donald. ``\TeX
: The
3338 Program''. Computers
{\char`\
&} Typesetting. ISBN 0-201-13437-3.}\biblio{%
3339 Knuth
, Donald. ``\TeX ware''. Stanford Computer Science Report
1097.
}.
3341 \edef\TeXwareBiblio
{\the\bibliocount
}
3344 @^device independent@
>
3346 At first
, names will be given for the commands in a \.
{DVI
} file.
3348 @d set_char_0
0 // Set a character and move
[up to
127]
3349 @d set1
128 // Take one parameter to set character
[up to
131]
3350 @d set_rule
132 // Set a rule and move down
, two parameters
3351 @d put1
133 // As |set1| but no move
[up to
136]
3352 @d put_rule
137 // As |set_rule| but no move
3353 @d nop
138 // No operation
3354 @d bop
139 // Beginning of a page
3355 @d eop
140 // End of a page
3356 @d push
141 // Push $
(h
,v
,w
,x
,y
,z
)$ to the stack
3357 @d pop
142 // Pop $
(h
,v
,w
,x
,y
,z
)$ from the stack
3358 @d right1
143 // Take one parameter
, move right
[up to
146]
3359 @d w0
147 // Move right $w$ units
3360 @d w1
148 // Set $w$ and move right
[up to
151]
3361 @d x0
152 // Move right $x$ units
3362 @d x1
153 // Set $x$ and move right
[up to
156]
3363 @d down1
157 // Take one parameter
, move down
[up to
160]
3364 @d y0
161 // Move down $y$ units
3365 @d y1
162 // Set $y$ and move down
[up to
165]
3366 @d z0
166 // Move down $z$ units
3367 @d z1
167 // Set $z$ and move down
[up to
170]
3368 @d fnt_num_0
171 // Select font
0 [up to
234]
3369 @d fnt1
235 // Take parameter to select font
[up to
238]
3370 @d xxx1
239 // Specials
[up to
242]
3371 @d fnt_def1
243 // Font definitions
[up to
246]
3372 @d pre
247 // Preamble
3373 @d post
248 // Postamble
3374 @d post_post
249 // Postpostamble
3376 @ We should now start reading the \.
{DVI
} file. Filenames of fonts being
3377 used will be sent to standard output.
3379 @
-p void read_dvi_file
(char
*filename
) {
3380 FILE*fp
=fopen
(filename
,"rb");
3381 if
(!fp
) dvi_error
(fp
,"Unable to open file");
3382 @
<Skip the preamble of the \.
{DVI
} file@
>;
3383 @
<Compute the conversion factor@
>;
3387 @ @
-p void dvi_error
(FILE*fp
,char
*text
) {
3388 fprintf
(stderr
,"DVI error");
3389 if
(fp
) fprintf
(stderr
," at %08X",ftell
(fp
));
3390 fprintf
(stderr
,": %s\n",text
);
3394 @ Please note the version number of the \.
{DVI
} file must be
2.
3396 @
<Skip the preamble of the \.
{DVI
} file@
>= {
3397 if
(fgetc
(fp
)!=pre
) dvi_error
(fp
,"Bad preamble");
3398 if
(fgetc
(fp
)!=2) dvi_error
(fp
,"Wrong DVI version");
3399 @
<Read the measurement parameters@
>;
3402 @ @
<Read the measurement parameters@
>= {
3403 unit_num
=get_dvi_number
(fp
,0,4);
3404 unit_den
=get_dvi_number
(fp
,0,4);
3405 unit_mag
=get_dvi_number
(fp
,0,4);
3408 @
*Layer Computation. Now is the chapter for actually deciding rendering on
3409 the page
, where everything should go
, etc.$^
{[\TeXwareBiblio
]}$
3411 @
<Global variables@
>=
3412 dvi_number unit_num
; // Numerator for units of measurement
3413 dvi_number unit_den
; // Denominator for units of measurement
3414 dvi_number unit_mag
; // Magnification for measurement
3415 dvi_measure unit_conv
; // Conversion factor
3417 @ There are also a number of ``internal typesetting quantities''. These
3418 are parameters stored in a separate array
, and are used to keep track of
3419 the current state of the typesetting. They are labeled with letters from
3420 \.A to \.Z. They can be modified inside of specials
, although some of them
3421 probably shouldn't be modified in this way. Here is the list of them
:
3423 \.D
: Maximum horizontal drift
(in pixels
), meaning how far away the \.I
3424 and \.J parameters are allowed to be from the correctly rounded values.
3426 \.E
: Maximum vertical drift.
3428 \.F
: The current font.
3430 \.H
: The horizontal position on the page
, in DVI units.
3432 \.I
: The horizontal position on the page
, in pixels.
3434 \.J
: The vertical position on the page
, in pixels.
3436 \.L
: The current layer number. If this is zero
, nothing is placed on the
3437 page
, although the positions can still be changed and specials can still
3440 \.R
, \.S
: The limits for when horizontal motion should add the number of
3441 pixels or when it should recalculate the pixels entirely.
3443 \.T
, \.U
: Like \.R and \.S
, but for vertical motions.
3445 \.V
: The vertical position on the page
, in DVI units.
3447 \.W
, \.
X, \.
Y, \.Z
: The current spacing amounts
, in DVI units.
3449 @d quan
(_name
) (type_quan
[(_name
)&0x1F])
3451 @
<Global variables@
>=
3452 dvi_number type_quan
[32];
3454 @ @
<Cases for system commands@
>=
3456 // Modify an internal typesetting quantity
3457 if
(stack_ptr-
>is_string
) program_error
("Type mismatch");
3458 quan
(*++ptr
)=pop_num
();
3462 @ The conversion factor |unit_conv| is figured as follows
: There are
3463 exactly |unit_num
/unit_den| decimicrons per DVI unit
, and
254000
3464 decimicrons per inch
, and |resolution
/100| pixels per inch. Then we have
3465 to adjust this by the magnification |unit_mag|.
3467 @d resolution
(registers
['D'
])
3469 @
<Compute the conversion factor@
>= {
3470 unit_conv
=make_fraction
(unit_num
*resolution
*unit_mag
,unit_den
*100000);
3473 @
*Layer Rendering. Please note
, these numbers are |short|
, which means
3474 that you cannot have more than
65536 pixels in width or in height. This
3475 should not be a problem
, because even if you have
3000 dots per inch
, and
3476 each card is
10 inches long
, that is still only
30000 which is less than
3477 half of the available width.
(All units here are in pixels.
)
3481 unsigned short x
; // X position on page
3482 unsigned short y
; // Y position on page
3483 unsigned short f
; // Font number
, |
0xFFFF| for a rule
3486 unsigned short w
; // Width of rule
3487 unsigned short h
; // Height of rule
3489 unsigned int c
; // Character number in current font
3493 @
*Layer Output. Layer files are output in \.
{PBM
} format
, which is very
3494 similar to the format which this program uses internally. ImageMagick is
3495 capable of reading this format.
3502 @
<Send the current layer to a file@
>= {
3504 fprintf
(fp
,"P4%d %d ",layer_width
,layer_height
);
3508 @
*Process of ImageMagick.
3512 @
*Main Program. This is where the program starts and ends. Everything else
3513 in the other chapters is started from here.
3522 @ @
-p int main
(int argc
,char
**argv
) {
3523 @
<Initialize memory@
>;
3524 @
<Display the banner message@
>;
3525 @
<Open the main input file@
>;
3526 @
<Initialize the input states@
>;
3527 @
<Initialize the tables and registers@
>;
3528 @
<Initialize the random number generator@
>;
3529 @
<Set registers according to command-line parameters@
>;
3530 @
<Process the input files@
>;
3531 @
<Call program in \.Z register if necessary@
>;
3532 @
<Send |end_transmission| to each card area@
>;
3533 @
<Write the output files@
>;
3537 @ @
<Display the banner message@
>= {
3538 fprintf
(stderr
,"TeXnicard version %s\n",version_string
);
3540 "This program is free software and comes with NO WARRANTY.\n");
3544 @ @
<Set registers according to command-line parameters@
>= {
3546 for
(i
=2;i
<argc
;i
++) {
3547 registers
[i
+('
0'
-2)].is_string
=1;
3548 registers
[i
+('
0'
-2)].text
=strdup
(argv
[i
]);
3552 @ The main input file will be either the terminal
, or another file if the
3553 command-line argument is given.
3555 @
<Open the main input file@
>= {
3556 if
(argc
>1 && strcmp(argv[1],"-")!=0) {
3557 --current_input_file
;
3558 open_input
(argv
[1]);
3561 strcpy
(current_filename
,"<Teletype>");
3565 @ @
<Call program in \.Z register if necessary@
>= {
3566 if
(registers
['Z'
].is_string
) execute_program
(registers
['Z'
].text
);
3569 @
*The Future. Here are some ideas for future versions of this program
:
3571 $\bullet$ A customizable Inform7-like parser
, that would compile into a C
3572 code
, so that you can play the cards on rule-enforcing computer programs.
3575 $\bullet$ A database to keep track of how many copies of a card have been
3576 sold
, for inventory purposes.
3577 @^commercial viability@
>
3579 $\bullet$ Full text search
, for things such as the Oracle text search.
3582 $\bullet$ Big spider
!
3589 \long\def\Par
{\csname par\endcsname
}%
3590 \loop\ifnum\count255
<\bibliocount
%
3591 \advance\count255 by
1
3592 \Par$^
{[\the\count255
]}$\csname biblio \the\count255\endcsname\Par
%