/* BLOCKS.PL */
:- module blocks.
:- public
is_block/2,
draw_block/1,
hjoin/4,
vjoin/4,
overlay/7,
block_width/2,
block_height/2,
block/2.
/*
SPECIFICATION
-------------
This module exports some predicates for constructing simple 2-D pictures
out of blocks of characters. The idea is based on "Blocks - a new
datatype for Snobol 4" by J F Gimpel, CACM volume 15, number 6, pages
483-447. I designed it as a quick way to support DRAW.PL: see that for
more explanation of its relevance to the Tutor.
A block is a picture built out of a rectangular array of characters (all
blocks are rectangular). You can make primitive blocks out of atoms and
lists. Atom blocks are displayed on a single line: 'abc' is displayed as
abc
.
List blocks are displayed on successive lines: [a,b,c] is displayed as
a
b
c
. Each element of a list block must be an atom or a list. List elements
must themselves be lists of atoms, and will be displayed as the
corresponding sequence of characters, so [ [a,a], [b,b] ] is displayed
as
aa
bb
.
You can make space-blocks. space(H,W) represents a rectangle of spaces
H high by W wide. (Should I swap the arguments in this one?)
You can join blocks horizontally with the + operator. a+b is displayed
as
ab
, and [a,b,c]+[x,y,z] is displayed as
ax
by
cz
.
You can join blocks vertically with the # operator. a#b is displayed as
a
b
, and (a+b)#c is displayed as
ab
c
When joining blocks with + and #, they are centered as far as possible,
so [a,b,c]+d is displayed as
a
bd
c
.
You can overlay blocks. The block a@(1,1)/b@(2,2) represents a block
formed by identifying the point at (1,1) in 'a' with that at (2,2) in
'b'.
Similarly,
abcde@(3,1) / [p,q,r,s,t]@(1,3)
represents the cross formed by identifying the 'c' in abcde with the 'r'
in [p,q,r,s,t], and would be displayed as
p
q
abcde
s
t
When this kind of overlaying is done, the overlaid blocks are padded
with spaces so as to make up the smallest rectangle which just contains
the overlaid blocks. Characters in the second block will be hidden by
those in the first, unless these are spaces.
The module provides an operator 'is_block' for forming blocks with the
above operators. This does not draw the blocks, it just makes blocks
which can later be drawn by calling 'draw_block'. The operators provided
are:
*/
:- op( 31,yfx,#).
:- op( 21,yfx,@).
:- op( 40,xfx,is_block).
/*
These operators are only syntactic sugar for some block-composition
predicates. These are described below.
PUBLIC B- is_block E+:
----------------------
E is an expression with the following abstract syntax:
Primitive ::= Atom |
List of atoms or lists of atoms |
space(H,W)
Block ::= Primitive |
Block # Block |
Block + Block |
Block@(AE,AE) / Block@(AE,AE)
B will be unified with the corresponding block. AE is an arithmetic
expression.
PUBLIC draw_block( B+ ):
------------------------
Draws block B, using output/1 to do the character output.
PUBLIC hjoin( B1+, B2+, B-, Gap+ ):
-----------------------------------
Block B is the result of joining the right face of B1 to the left face
of B2. Gap specifies the blocks' vertical alignment, and can be 'top',
'bottom', 'centre', or an integer. In the latter case, it specifies the
amount by which the top of B2 projects above that of B1. B will be the
smallest rectangle that contains the result.
PUBLIC vjoin( B1+, B2+, B-, Gap+ ):
-----------------------------------
Block B is the result of joining the bottom face of B1 to the top face
of B2, i.e. of placing B1 on B2. Gap specifies the blocks' vertical
alignment, and can be 'left', 'right', 'centre', or an integer. In the
latter case, it specifies the amount by which the left face of B2
projects to the left face of B1. B will be the smallest rectangle that
contains the result.
PUBLIC overlay( B1+, X1+, Y1+, B2+, X2+, Y2+, B- ):
---------------------------------------------------
Block B is the result of identifying (X1,Y1) in B1 with (X2,Y2) in B2. B
will be the smallest rectangle that includes the result. When drawing
the result, if one non-space character is overlaid on another, and the
output device does not permit both to be displayed, that from B1
will be displayed.
PUBLIC block_width( B+, W? ):
-----------------------------
W is the width of block B.
PUBLIC block_height( B+, H? ):
------------------------------
H is the height of block B.
PUBLIC block( LA+, B- ):
------------------------
LA is a list or atom. B is the corresponding block.
*/
/*
IMPLEMENTATION
--------------
Primitive blocks are represented as structures containing the atom or
list. Non-primitive blocks are represented as trees of blocks. We use
the following structures:
atom_block( Atom, Width )
An atom with Width characters, height is 1.
list_block( List, Height, Width)
A list.
space_block( Height, Width )
A block of Height by Width spaces.
vjoin_block( B1, B2, Height, Width )
B1 on top of B2.
hjoin_block( B1, B2, Height, Width )
B1 to the left of B2.
overlay_block( B1, X1, Y1, B2, X2, Y2, Height, Width )
B1 and B2 overlaid. The result of overlaying is a rectangle
which is at least as large as B1 and B2. X1,Y1 give the location
of B1's top-left corner therein; X2,Y2 do the same for B2.
Note that (apart from atoms), all these structures specify both the
height and the width of the combination. These are calculated whenever
a new node is built, to save doing it on drawing.
The co-ordinate system for blocks has X running as normal from left to
right, but Y is reversed, running from top to bottom. Each block's
origin is at (1,1), its top-left corner.
The block arguments of a vjoin node are always the same width.
Similarly, those of an hjoin node are always the same height. How is
this, given that you can do (e.g.) a#bcd? The answer is that if
necessary, the narrower or smaller block is padded with spaces. This in
turn is done by hjoining or vjoining it to a space block.
Doing this may be somewhat inefficient, but it made it easier for me to
write the program.
To draw a block, we work down from its top, constructing one line of
characters at a time and outputting that. This will in turn usually involve
taking lines from the component blocks and combining them.
Each line is represented as a list of segments, where a segment is
seg( Start, Text, Last )
Start is a position in the output line (left margin at 1); Text is an
atom or a list of atoms; Last is the position of its rightmost
character. This representation avoids the need to represent spaces
explicitly.
*/
:- needs
append / 3,
assertion / 2,
is_space_char / 1,
length / 2,
max / 3,
min / 3,
nth1 / 3.
/*
Representation of blocks.
-------------------------
The predicates below act as constructors and selectors for a block's
height and width, and for its component blocks. A bit slower than
unifying the structures in the head of block-handling clauses, but makes
it easier to change the representation.
See the implementation comments for what the constructed structures mean.
*/
atom_block( atom_block( Atom, Width ), Atom, Width ).
list_block( list_block( List, Height, Width), List, Height, Width ).
space_block( space_block( Height, Width ), Height, Width ).
vjoin_block( vjoin_block( B1, B2, Height, Width), B1, B2, Height, Width ).
hjoin_block( hjoin_block( B1, B2, Height, Width), B1, B2, Height, Width ).
overlay_block( overlay_block( B1, X1, Y1, B2, X2, Y2, Height, Width ), B1, X1, Y1, B2, X2, Y2, Height, Width ).
/* Exported predicate. */
block_height( atom_block( _, _ ), 1 ) :- !.
block_height( list_block( _, Height, _ ), Height ) :- !.
block_height( space_block( Height, _ ), Height ) :- !.
block_height( vjoin_block( _, _, Height, Width), Height ) :- !.
block_height( hjoin_block( _, _, Height, Width), Height ) :- !.
block_height( overlay_block( _, _, _, _, _, _, Height, Width), Height ) :- !.
/* Exported predicate. */
block_width( atom_block( _, Width ), Width ) :- !.
block_width( list_block( _, _, Width), Width ) :- !.
block_width( space_block( _, Width ), Width ) :- !.
block_width( vjoin_block( _, _, Height, Width), Width ) :- !.
block_width( hjoin_block( _, _, Height, Width), Width ) :- !.
block_width( overlay_block( _, _, _, _, _, _, _, Width), Width ) :- !.
/*
Block operations.
-----------------
vjoin works out whether either or both of its components needs
horizontal padding on one side or the other.
hjoin does the same for vertical padding.
overlay converts its (X1,Y1), (X2,Y2) (specifying where the two blocks
are identified) into coordinates giving each block's offset within the
resulting block.
*/
/* Exported predicate. */
vjoin( B1, B2, B, left ) :-
!,
vjoin( B1, B2, B, 0 ).
vjoin( B1, B2, B, right ) :-
!,
block_width( B1, W1 ),
block_width( B2, W2 ),
Gap is W2 - W1,
vjoin( B1, B2, B, Gap ).
vjoin( B1, B2, B, centre ) :-
!,
block_width( B1, W1 ),
block_width( B2, W2 ),
Gap is (W2 - W1) div 2,
vjoin( B1, B2, B, Gap ).
vjoin( B1, B2, B, B2_left_B1 ) :-
block_width( B1, W1 ),
block_width( B2, W2 ),
block_height( B1, H1 ),
block_height( B2, H2 ),
(
B2_left_B1 > 0
->
pad_at_left( BP1, B1, B2_left_B1 ), BP2 = B2
;
B1_left_B2 is -B2_left_B1,
pad_at_left( BP2, B2, B1_left_B2 ), BP1 = B1
),
B2_right_B1 is (W2 - B2_left_B1) - W1,
(
B2_right_B1 > 0
->
pad_at_right( BPP1, BP1, B2_right_B1 ), BPP2 = BP2
;
B1_right_B2 is -B2_right_B1,
pad_at_right( BPP2, BP2, B1_right_B2 ), BPP1 = BP1
),
Height is H1 + H2,
(
B2_left_B1 > 0
->
W1_and_Gap is W1 + B2_left_B1,
max( W1_and_Gap, W2, Width )
;
W2_less_Gap is W2 - B2_left_B1,
max( W1, W2_less_Gap, Width )
),
vjoin_block( B, BPP1, BPP2, Height, Width ).
/* Exported predicate. */
hjoin( B1, B2, B, top ) :-
!,
hjoin( B1, B2, B, 0 ).
hjoin( B1, B2, B, bottom ) :-
!,
block_height( B1, H1 ),
block_height( B2, H2 ),
Gap is H2 - H1,
hjoin( B1, B2, B, Gap ).
hjoin( B1, B2, B, centre ) :-
!,
block_height( B1, H1 ),
block_height( B2, H2 ),
Gap is (H2 - H1) div 2,
hjoin( B1, B2, B, Gap ).
hjoin( B1, B2, B, B2_above_B1 ) :-
block_height( B1, H1 ),
block_height( B2, H2 ),
block_width( B1, W1 ),
block_width( B2, W2 ),
(
B2_above_B1 > 0
->
pad_at_top( BP1, B1, B2_above_B1 ), BP2 = B2
;
B1_above_B2 is -B2_above_B1,
pad_at_top( BP2, B2, B1_above_B2 ), BP1 = B1
),
B2_below_B1 is (H2 - B2_above_B1) - H1,
(
B2_below_B1 > 0
->
pad_at_bottom( BPP1, BP1, B2_below_B1 ), BPP2 = BP2
;
B1_below_B2 is -B2_below_B1,
pad_at_bottom( BPP2, BP2, B1_below_B2 ), BPP1 = BP1
),
Width is W1 + W2,
(
B2_above_B1 > 0
->
H1_and_Gap is H1 + B2_above_B1,
max( H1_and_Gap, H2, Height )
;
H2_less_Gap is H2 - B2_above_B1,
max( H1, H2_less_Gap, Height )
),
hjoin_block( B, BPP1, BPP2, Height, Width ).
/* Exported predicate. */
overlay( B1, X1, Y1, B2, X2, Y2, B ) :-
block_height( B1, H1 ),
block_height( B2, H2 ),
block_width( B1, W1 ),
block_width( B2, W2 ),
Top2 is Y1-Y2,
min( Top2, 0, Top ),
Bottom2 is Y1 + (H2 - Y2),
max( H1, Bottom2, Bottom ),
Height is Bottom - Top,
Left2 is X1-X2,
min( Left2, 0, Left ),
Right2 is X1 + (W2 - X2),
max( W1, Right2, Right ),
Width is Right - Left,
(
Y2 > Y1
->
Y1_ is -Top2,
Y2_ = 0
;
Y1_ = 0,
Y2_ = Top2
),
(
X2 > X1
->
X1_ is -Left2,
X2_ = 0
;
X1_ = 0,
X2_ = Left2
),
overlay_block( B, B1, X1_, Y1_, B2, X2_, Y2_, Height, Width ).
/*
Constructing blocks from atoms and lists.
-----------------------------------------
Most of the business here is calculating the length of such blocks.
*/
/* Exported predicate. */
block( List, B ) :-
( List = [] ; List = [_|_] ),
!,
length( List, Height ),
max_width( List, 0, Width ),
list_block( B, List, Height, Width ).
block( Atom, B ) :-
atom(Atom),
!,
atom_length( Atom, Width ),
atom_block( B, Atom, Width ).
/* max_width( L+, WidthSoFar+, TotalWidth- ):
Used in calculating the maximum width of a list block.
L is a list of atoms or atom lists. Width is the width
known so far; TotalWidth is the maximum of WidthSoFar and
of L.
*/
max_width( [], WidthSoFar, WidthSoFar ) :- !.
max_width( [H|T], WidthSoFar, TotalWidth ) :-
sum_widths( H, HWidth ),
max( HWidth, WidthSoFar, Max ),
max_width( T, Max, TotalWidth ).
/* sum_widths( L+, W- ):
L is an atom or list of atoms. If an atom, W is its length. If a
list of atoms, W is the sum of their lengths.
This predicate gives, therefore, the total width of one element
(one line) in a list block.
*/
sum_widths( [], 0 ) :- !.
sum_widths( A, AWidth ) :-
atom(A),
!,
atom_length( A, AWidth ).
sum_widths( [H|T], Width ) :-
atom_length( H, HWidth ),
sum_widths( T, TWidth ),
Width is HWidth + TWidth.
/* atom_length( Atom+, Length- ):
Length is the length of Atom. All characters are assumed to
print in one space, i.e. no tabs, newlines, etc.
*/
atom_length( Atom, Length ) :-
name( Atom, Atomchars ),
length( Atomchars, Length ).
/*
Padding blocks.
---------------
As mentioned in the implementation comments, we pad blocks to make vjoin
and hjoin easier to implement. Padding is done by hjoining or vjoining
with space blocks.
*/
/* pad_at_top( Bp-, B+, Gap+ ):
Bp is B padded on top with a block of the same width and Gap
high.
*/
pad_at_top( B, B, 0 ) :- !.
pad_at_top( Bp, B, Gap ) :-
block_width( B, Width ),
block_height( B, Height ),
TotalHeight is Height + Gap,
space_block( Spaces, Gap, Width ),
vjoin_block( Bp, Spaces, B, TotalHeight, Width ).
/* pad_at_left( Bp-, B+, Gap+ ):
Bp is B padded on the left with a block of the same height and
Gap wide.
*/
pad_at_left( B, B, 0 ) :- !.
pad_at_left( Bp, B, Gap ) :-
block_width( B, Width ),
block_height( B, Height ),
TotalWidth is Width + Gap,
space_block( Spaces, Height, Gap ),
hjoin_block( Bp, Spaces, B, Height, TotalWidth ).
/* pad_at_bottom( Bp-, B+, Gap+ ):
Bp is B padded on the bottom with a block of the same width and
Gap high.
*/
pad_at_bottom( B, B, 0 ) :- !.
pad_at_bottom( Bp, B, Gap ) :-
block_width( B, Width ),
block_height( B, Height ),
TotalHeight is Height + Gap,
space_block( Spaces, Gap, Width ),
vjoin_block( Bp, B, Spaces, TotalHeight, Width ).
/* pad_at_right( Bp-, B+, Gap+ ):
Bp is B padded on the right with a block of the same height and
Gap wide.
*/
pad_at_right( B, B, 0 ) :- !.
pad_at_right( Bp, B, Gap ) :-
block_width( B, Width ),
block_height( B, Height ),
TotalWidth is Width + Gap,
space_block( Spaces, Height, Gap ),
hjoin_block( Bp, B, Spaces, Height, TotalWidth ).
/*
Drawing blocks.
---------------
To draw a block, we extract lines from the top down.
*/
/* Exported predicate. */
draw_block( B ) :-
block_height( B, H ),
draw_lines( 1, H, B ).
/* draw_lines( Low+, High+, Block+ ):
Draw those lines which correspond to Y-coordinates Low...High in
Block. Align Block's X=1 coordinate with the left-hand page
margin.
Low must be >= 1; High must be =< Block's height.
*/
draw_lines( Low, High, Block ) :-
Low =< High,
!,
line_from( 1, _, Block, Low, Line ),
draw_line( 1, Line ),
nl,
Next is Low + 1,
draw_lines( Next, High, Block ).
draw_lines( _, _, _ ).
/* draw_line( Margin+, Line+ ):
Write out line, taking each segment's starting point relative
to Margin.
*/
draw_line( _, [] ) :- !.
draw_line( Margin, [ seg(Start,Text,Last) | Rest ] ) :-
Skip is Start - Margin,
output( spaces_(Skip) ),
(
atom( Text )
->
write( Text )
;
output( seplist_(Text,'') )
),
NewMargin is Last + 1,
draw_line( NewMargin, Rest ).
/*
Low-level drawing.
------------------
The important predicate here is line_from.
*/
/* line_from( Start+, NewStart-, B+, Y+, Line- ):
Line is a list of segments (see implementation comments)
representing B's Yth line.
Start specifies the character position to be assigned to
Line's first character. NewStart will become the position
of the first character to Line's right.
It is a program invariant that Y is always =< 1 and >= B's
height. line_from will crash if this condition is violated. The
block padding ensures it for hjoin and vjoin blocks, and tests
in line_from ensure it for overlay blocks.
*/
line_from( Start, NewStart, B, Lno, [ seg(Start,Text,Last) ] ) :-
atom_block( B, Text, Width ),
!,
assertion( Lno=1, 'line_from(atom_block)' ),
Last is Start + (Width-1),
NewStart is Last + 1.
line_from( Start, NewStart, B, Lno, [ seg(Start,Text,Last) ] ) :-
list_block( B, List, Height, Width ),
!,
assertion( (Lno>=1, Lno==1, Lno==1, Lno==1, Lno=
line_from( Start, NewStart, B1, Lno, Line )
;
Ld is Lno - H1,
line_from( Start, NewStart, B2, Ld, Line )
).
line_from( Start, NewStart, B, Lno, Line ) :-
overlay_block( B, B1, X1, Y1, B2, X2, Y2, _, _ ),
!,
block_height( B1, H1 ),
block_height( B2, H2 ),
(
Up1 is Y1+H1,
Lno > Y1, Lno =< Up1
->
Lno1 is Lno-Y1,
Start1 is Start + X1,
line_from( Start1, NewStart1, B1, Lno1, Line1 )
;
Line1 = [],
NewStart1 = Start
),
(
Up2 is Y2+H2,
Lno > Y2, Lno =< Up2
->
Lno2 is Lno-Y2,
Start2 is Start + X2,
line_from( Start2, NewStart2, B2, Lno2, Line2 )
;
Line2 = [],
NewStart2 = Start
),
max( NewStart1, NewStart2, NewStart ),
interleave( Line1, Line2, Line ).
/* interleave( L1+, L2+, L3- ):
L3 is the segment-list formed by overlaying L1 and L2.
Conceptually, this is done by overlaying each character (C2) in
L2 with that at the same output position (C1) in L1. If C1 is a
space, then the result is C2, otherwise C1.
*/
interleave( A, [], A ) :- !.
interleave( [], B, B ) :- !.
interleave( [A1|A2_n], [B1|B2_n], [B1|URest] ) :-
segment_is_less_and_not_coalescable( B1, A1 ),
interleave( [A1|A2_n], B2_n, URest ), !.
interleave( [A1|A2_n], [B1|B2_n], [A1|URest] ) :-
segment_is_less_and_not_coalescable( A1, B1 ),
interleave( A2_n, [B1|B2_n], URest ), !.
interleave( [A1|A2_n], [B1|B2_n], U ) :-
/* A1 overlaps B1 */
segment_union( A1, B1, U1 ),
union_overlap( U1, A2_n, B2_n, U ).
/*
Handling segment-lists.
-----------------------
These are the low-level predicates for combining segment-lists.
The idea behind these is taken from my entry INTERVALS in my
public-domain library. As mentioned in the implementation section, we
represent lines as lists of elements
seg(Start,Text,Last)
Any character between segments is assumed to be a space.
When overlaying one line with another, we form a new segment list
which represents the result of overlaying (see spec. for 'interleave').
Because our output device will only allow one character to be output
at any position, we can use segments to represent this result.
Our new segment-list is canonical in the following sense: the upper
bound of segment N is always at least two less than the lower bound of
segment N+1. I call such segments non-coalescable.
*/
/* union_overlap( Seg1+, Segs2+, Segs3+, Segs4- ):
Segs4 is the result of overlaying Seg1, Segs2 and Segs3.
*/
union_overlap( U1, [A1|A2_n], B, URest ) :-
segments_are_coalescable( U1, A1 ),
segment_union( U1, A1, J ),
union_overlap( J, A2_n, B, URest ), !.
union_overlap( U1, A, [B1|B2_n], URest ) :-
segments_are_coalescable( U1, B1 ),
segment_union( U1, B1, J ),
union_overlap( J, A, B2_n, URest ), !.
union_overlap( U1, A, B, [U1|URest] ) :-
interleave( A, B, URest ), !.
/* segment_is_less_and_not_coalescable( Seg1+, Seg2+ ):
Seg1 is strictly less than Seg2, and cannot be coalesced
with it.
*/
segment_is_less_and_not_coalescable( seg(_,_,U1), seg(L2,_,_) ) :-
L2_less_1 is L2-1,
U1 < L2_less_1, !.
/* segments_are_not_coalescable( Seg1, Seg2 ):
Segments Seg1 and Seg2 cannot be coalesced.
*/
segments_are_not_coalescable( Seg1, Seg2 ) :-
segment_is_less_and_not_coalescable( Seg1, Seg2 ), !.
segments_are_not_coalescable( Seg1, Seg2 ) :-
segment_is_less_and_not_coalescable( Seg2, Seg1 ), !.
/* segments_are_coalescable( Seg1+, Seg2+ ):
Segments Seg1 and Seg2 can be coalesced.
*/
segments_are_coalescable( Seg1, Seg2 ) :-
not( segments_are_not_coalescable( Seg1, Seg2 ) ).
/* segment_union( Seg1+, Seg2+, Seg3- ):
The first two arguments are segments which overlap, i.e. which
are coalescable.
The third is a new segment which is the result of coalescing
them.
*/
segment_union( seg(L1,Text1,U1), seg(L2,Text2,U2), seg(L3,Text3,U3) ) :-
min( L1, L2, L3 ),
max( U1, U2, U3 ),
name( Text1, Chars1 ),
name( Text2, Chars2 ),
merge_lists( L1, Chars1, L2, Chars2, Chars3 ),
name( Text3, Chars3 ).
/* merge_lists( L1+, Chars1+, L2+, Chars2+, Chars3- ):
L1 and L2 are the character positions at which the first
elements of character-lists Chars1 and Chars2 are to be output.
Chars3 is a new character list whose first element is to be
output at min(L1,L2). It is the result of merging Chars1 and
Chars2, in the following sense:
Let C3 be the N3rd character of Chars3.
Let L3 = min(L1,L2).
Let N1 and N2 be the positions in Chars1 and Chars2 of the
characters C1 and C2 that are to be merged to form C3.
Then N1 = L3-L1+N3, N2 = L3-L2+N3.
If N1 < 1 or > length(Chars1), then C3 = C2.
If N2 < 2 or > length(Chars2), then C3 = C1.
If C1 = space, then C3 = C2.
If C2 = space, then C3 = C1.
Otherwise, C3 = C1.
*/
merge_lists( _, [], _, L2, L2 ) :- !.
merge_lists( _, L1, _, [], L1 ) :- !.
merge_lists( S1, [H1|T1], S2, L2, [H1|T3] ) :-
S1 < S2,
!,
S1_plus_1 is S1 + 1,
merge_lists( S1_plus_1, T1, S2, L2, T3 ).
merge_lists( S1, L1, S2, [H2|T2], [H2|T3] ) :-
S1 > S2,
!,
S2_plus_1 is S2 + 1,
merge_lists( S1, L1, S2_plus_1, T2, T3 ).
merge_lists( S, [H1|T1], S, [H2|T2], [H3|T3] ) :-
!,
(
is_space_char(H1)
->
H3 = H2
;
is_space_char(H2)
->
H3 = H1
;
H3 = H1
),
S_plus_1 is S + 1,
merge_lists( S_plus_1, T1, S_plus_1, T2, T3 ).
/*
Evaluating block expressions.
-----------------------------
Note that such expressions are restricted. For example, # joins blocks
along their horizontal midpoints (off by 1 possibly, to allow for
character height), but there is no way to join them at other points using
is_block.
You could add a clause
eval_block( ?(B,Goal), B ) :-
!,
assertion( Goal, 'eval_block: Goal failed' ).
to deal with such other cases, allowing arbitrary predicates to be
called. B will occur in Goal and be bound to its result.
Example:
B is_block a#?(B,hjoin(B1,B2,B,23)).
I think I pinched this idea from Prolog-2.
*/
/* eval_block( E+, B- ):
Evaluate expression E into B.
*/
eval_block( Thing, Block ) :-
( Thing = [] ; Thing = [_|_] ; atom(Thing) ),
!,
block( Thing, Block ).
eval_block( B1+B2, Block ) :-
!,
eval_block( B1, EB1 ),
eval_block( B2, EB2 ),
hjoin( EB1, EB2, Block, centre ).
eval_block( B1#B2, Block ) :-
!,
eval_block( B1, EB1 ),
eval_block( B2, EB2 ),
vjoin( EB1, EB2, Block, centre ).
eval_block( B1@(X1,Y1)/B2@(X2,Y2), Block ) :-
!,
eval_block( B1, EB1 ),
eval_block( B2, EB2 ),
EX1 is X1,
EY1 is Y1,
EX2 is X2,
EY2 is Y2,
overlay( EB1, EX1, EY1, EB2, EX2, EY2, Block ).
eval_block( space(H,W), Block ) :-
!,
space_block( Block, H, W ).
eval_block( B, B ).
/* Exported predicate. */
(B is_block Expr) :-
eval_block( Expr, B ).
:- endmodule.