!**************************************************************************!
! !
! Pattern Module for EDWIN !
! !
! Created 15/11/88 By AET !
! !
!**************************************************************************!
from Edwin include Device
from Edwin include Consts
from EdwIn include pattern
from Edwin include Iprocs
from Imp include Lognames
from Imp include Textutils
const string (17) edwin patterns = "EDWIN_PATTERNS"
const integer End Of Patterns = |Min Edwin Style|*16+15
external integer array Patterns (0:Max Pat*16+15)
const integer array Base Patterns (0:End Of Patterns) =
{outline}
{0} 16_0000(16),
{solid}
{1} 16_FFFF(16),
{horizontal}
{2} 16_FFFF,
16_0000(3),
16_FFFF,
16_0000(3),
16_FFFF,
16_0000(3),
16_FFFF,
16_0000(3),
{vertical}
{3} 16_8888(16),
{/diagonal}
{4} 16_8888,
16_4444,
16_2222,
16_1111,
16_8888,
16_4444,
16_2222,
16_1111,
16_8888,
16_4444,
16_2222,
16_1111,
16_8888,
16_4444,
16_2222,
16_1111,
{¬diagonal}
{5} 16_1111,
16_2222,
16_4444,
16_8888,
16_1111,
16_2222,
16_4444,
16_8888,
16_1111,
16_2222,
16_4444,
16_8888,
16_1111,
16_2222,
16_4444,
16_8888,
{cross hatch}
{6} 16_1111,
16_2A2A,
16_4444,
16_8A8A,
16_1111,
16_A2A2,
16_4444,
16_A8A8,
16_1111,
16_2A2A,
16_4444,
16_8A8A,
16_1111,
16_A2A2,
16_4444,
16_A8A8,
{grid hatch}
{7} 16_FFFF,
16_8888(3),
16_FFFF,
16_8888(3),
16_FFFF,
16_8888(3),
16_FFFF,
16_8888(3),
{light stipple}
{8} 16_0000,
16_4242,
16_0000(4),
16_4242,
16_0000(2),
16_4242,
16_0000(4),
16_4242,
16_0000,
{checker board}
{9} 16_F0F0(4),
16_0F0F(4),
16_F0F0(4),
16_0F0F(4),
{bricks}
{10} 16_FFFF,
16_4040(3),
16_FFFF,
16_0202(3),
16_FFFF,
16_4040(3),
16_FFFF,
16_0202(3),
{Half Tone}
{11}
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
{Half Tone2}
{12}
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
2_0101010101010101,
2_1010101010101010,
{P+}
{13}
2_0000001000000010,
2_0000011100000111,
2_0000001000000010,
2_0111100001111000,
2_0100100001001000,
2_0111100001111000,
2_0100000001000000,
2_0000000000000000,
2_0000001000000010,
2_0000011100000111,
2_0000001000000010,
2_0111100001111000,
2_0100100001001000,
2_0111100001111000,
2_0100000001000000,
2_0000000000000000,
{N+}
{14}
2_0000001000000010,
2_0000011100000111,
2_0000001000000010,
2_0100010001000100,
2_0110010001100100,
2_0101010001010100,
2_0100110001001100,
2_0000000000000000,
2_0000001000000010,
2_0000011100000111,
2_0000001000000010,
2_0100010001000100,
2_0110010001100100,
2_0101010001010100,
2_0100110001001100,
2_0000000000000000,
{P-}
{15}
2_0000000000000000,
2_0000011100000111,
2_0000000000000000,
2_0111100001111000,
2_0100100001001000,
2_0111100001111000,
2_0100000001000000,
2_0000000000000000,
2_0000000000000000,
2_0000011100000111,
2_0000000000000000,
2_0111100001111000,
2_0100100001001000,
2_0111100001111000,
2_0100000001000000,
2_0000000000000000,
{N-}
{16}
2_0000000000000000,
2_0000011100000111,
2_0000000000000000,
2_0100010001000100,
2_0110010001100100,
2_0101010001010100,
2_0100110001001100,
2_0000000000000000,
2_0000000000000000,
2_0000011100000111,
2_0000000000000000,
2_0100010001000100,
2_0110010001100100,
2_0101010001010100,
2_0100110001001100,
2_0000000000000000
routine Fault (string (255) S)
Oper Message ("Fatal Error - ".S)
stop
end
external routine Read Patterns alias "EDWIN___READ_PATTERNS" (integer Res)
integer Style, Count, old stream
integer array Pattern (0:15)
routine Read Line (integer name Value)
integer I, S
I = 0
Value = 0
cycle
read symbol (S)
if S = NL start
if I # 16 start
Fault ("Edwin pattern line for style ".ItoS(Style,0).-
" was ".ItoS(I,0)." long (should be 16)")
finish
return
else if S = '1' or S = '0'
Value = Value << 1 ! (S-'0')
I = I + 1
else if S # ' '
Fault ("Edwin pattern for style ".ItoS(Style,0).-
" contained the character '".S."'")
finish
repeat
end
on * start
if Event_Event # 9 start
Fault ("Invalid format for Edwin pattern definition file")
else
if Old Stream >= 0 start
close input
select input (old stream)
finish
finish
return
finish
Old Stream = -1
Patterns(Count) = Base Patterns(Count) for Count = 0, 1, End Of Patterns
Patterns(Count) = 0 for Count = End Of Patterns+1, 1, (Max Pat*16+15)
if Res >= 200 start
Explode Pattern(Patterns(Count*16)) for Count = 1,1,|Min Edwin Style|
finish
return if Translate (edwin patterns) = edwin patterns
begin
on 9 start
Fault ("Unable to open Edwin patterns in """. -
Translate (edwin patterns)."""")
finish
open input (7, Translate (edwin Patterns))
old stream = Input Stream
select input (7)
end
cycle
style=0
Read (style)
unless 1<=Style<=31 start
Fault ("Pattern number must be in the range 1 to 31 (was ".-
ItoS(Style,0).")")
finish
Read Symbol (count) until Count = NL
for Count = 0, 1, 15 cycle
Read Line (Pattern(Count))
repeat
for Count = 0, 1, 15 cycle
Patterns ((Style<<4)!(Count)) = Pattern (Count)
repeat
repeat
end
external routine Rotate Pattern alias "EDWIN___ROTATE_PATTERN" -
(integer name Patt, integer Dir)
integer array Pattern(0:15)
integer i, j, Mask
if Dir < 0 start
for i = 0, 1, 15 cycle
Pattern(i) = 0
Mask = 16_8000>>i
for j = 0, 1, 15 cycle
Pattern(i) = Pattern(i)!(16_0001<<j) if Patt[j]&Mask # 0
repeat
repeat
else
for i = 15, -1, 0 cycle
Pattern(i) = 0
Mask = 16_8000>>i
for j = 0, 1, 15 cycle
Pattern(i) = Pattern(i)!(16_8000>>j) if Patt[j]&Mask # 0
repeat
repeat
finish
Patt[i] = Pattern(i) for i = 0, 1, 15
end
external routine Explode Pattern alias "EDWIN___EXPLODE_PATTERN" -
(integer name Patt)
integer array Pattern(0:15)
integer Mask, i, Xi, Yi, Yo=0
for Yi = 0, 1, 7 cycle
i = 0
Pattern(Yo) = 0
for Xi = 0, 1, 7 cycle
Mask = 16_8000>>Xi
if Patt[Yi]&Mask # 0 start
Pattern(Yo) = Pattern(Yo)!(Mask>>i)!(Mask>>(i+1))
finish
i = i + 1
repeat
Pattern(Yo+1) = Pattern(Yo)
Yo = Yo + 2
repeat
Patt[Yo] = Pattern(Yo) for Yo = 0, 1, 15
end
endoffile