begin; !DECODE for CalComp plot files. A.D. Culloch, Fela AG, Schweiz, JUN-83
string(2) fn spec Xbyte ( integer X )
!Imp77 event numbers
constant integer Imp IO Error = 9
constant integer Report Stream = 0; !SYS$OUTPUT
constant integer Decode Stream = 1; !Main output: decoded file
constant integer ListingStream = 2; !Listing output channel #2, (hex dump)
!Plotter switch-settable parameters
constant integer Sync Chars = 1; !Valid values are 1 or 2
constant integer Sync Char = 2; !ISO code for sync character = <2>
constant integer End Msg Char = 3; !ISO
!Other plotter parameters
integer Radix = 64
!Global data buffer
byte array Buffer(1:128)
!and control information
integer Bias; !Character code offset for this buffer
integer Bp = 0, Blen = 0; !Initially empty
integer Record Number = 0; !Counts input data records
integer Col
routine Report ( string(255) Mess )
integer Prev = Out Stream; !Current output stream number
Select Output ( Report Stream )
Print String ( "At data record ".ItoS(Record Number,0).": ")
Print Symbol ( '<' )
Print String ( Mess )
Print Symbol ( '>' )
Newline
Select Output (Prev)
end
routine Refill Buffer
integer Sym
on Imp IO Error start
stop
finish
Sync: !Skip junk, past the sync sequence
while Next Symbol # Sync Char cycle
Print Symbol(Next Symbol)
Skip Symbol
repeat
Skip Symbol
if Sync Chars = 2 start
if Next Symbol # Sync Char start
Print Symbol(Next Symbol)
Report("Missing second sync char")
->Sync
finish
Skip Symbol
finish
Record Number = Record Number + 1
Read Symbol (Bias)
unless Bias > End Msg Char start
Report("Bias <".ItoS(Bias,0)."> leq end message char")
finish
!Read message proper
Blen = 0
cycle
Read Symbol(Sym)
exit if Sym = End Msg Char
Blen = Blen + 1
if Blen <= 128 start
Buffer(Blen) = Sym
finish
repeat
!For the moment, ignore things like the response request sequence
!Reset control pointers describing the buffer
Bp = 0
Col = 1; Newline
end
routine Get Unbiased Symbol ( integer name Sym )
own integer Old
Bp = Bp + 1
if Bp > Blen start; !Buffer exhausted
Refill Buffer
Get Unbiased Symbol(Sym)
else; !Extract next character
Sym = Buffer(Bp)
Old = Out Stream
Select Output(Listing Stream)
Print String(Xbyte(Sym))
Space
Newline and Col = 0 if Col = 20
Col = Col + 1
Select Output(Old)
finish
end
routine Get Symbol ( integer name Sym ); !Biased
Get Unbiased Symbol (Sym)
Sym = Sym-Bias
end
routine Parse String ( string(*) name S )
integer Len, Sym, j
Get Symbol(Len)
S = ""
for j = 1, 1, Len cycle
Get Unbiased Symbol(Sym)
S = S . To String(Sym)
repeat
end
routine Parse Split String ( string(*) name S )
integer Len, Sym1, Sym2, j
Get Symbol(Len)
S = ""
for j = 1, 1, Len cycle
Get Symbol(Sym1); Get Symbol(Sym2)
S = S . To String((Sym1&16_f)<<4 ! Sym2&16_f)
repeat
end
integer function Sign ( integer I )
if I < 0 start
result = -1
else if I = 0
result = 0
else
result = +1
finish
end
routine Parse Delta ( integer Delta Code, integer name X, Y )
constant integer Delta Codes = 49
constant byte array Delta(0:Delta Codes-1) =
8_21, 8_51, 8_55, 8_34, 8_54, 8_50, 8_20,
8_61, 8_25, 8_71, 8_40, 8_70, 8_24, 8_60,
8_65, 8_75, 8_31, 8_44, 8_30, 8_74, 8_64,
8_35, 8_41, 8_45, 0, 8_46, 8_42, 8_36,
8_67, 8_77, 8_33, 8_47, 8_32, 8_76, 8_66,
8_63, 8_27, 8_73, 8_43, 8_72, 8_26, 8_62,
8_23, 8_53, 8_57, 8_37, 8_56, 8_52, 8_22
integer j, Xdig, Ydig, Xsign, Ysign, k, Sym
for j = 0, 1, Delta Codes-1 cycle
if Delta Code = Delta(j) start
Ydig = - ( j//7-3 )
Xdig = Rem(j,7)-3
Xsign = Sign(Xdig)
Ysign = Sign(Ydig)
X = 0
Y = 0
for k = 1, 1, |Xdig| cycle
Get Symbol(Sym)
X = Radix*X + Sym
repeat
for k = 1, 1, |Ydig| cycle
Get Symbol(Sym)
Y = Radix*Y + Sym
repeat
Report("Delta > 32767") if X > 32767 or Y > 32767
X = Xsign*X
Y = Ysign*Y
return
finish
repeat
Report("illegal delta-command")
end
routine Print Filtered String ( string(255) S )
integer j
for j = 1, 1, Length(S) cycle
if ' ' <= Char No(S,j) < 127 start
Print Symbol(Char No(S,j))
else
Print String("<".ItoS(Char No(S,j),0).">")
finish
repeat
end
routine Print Quoted String ( string(255) S )
Print Symbol('"')
Print Filtered String(S)
Print Symbol('"')
end
routine Print Delta ( integer X, Y )
Print Symbol('(')
Write(X,0)
Print Symbol(',')
Write(Y,0)
Print Symbol(')')
end
string(2) fn Xbyte ( integer Byte )
constant byte array Hex Char(0 : 16_F) =
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
'a', 'b', 'c', 'd', 'e', 'f'
result = To String(Hex Char(Byte>>4 & 16_F)) . c
To String(Hex Char(Byte & 16_F))
end
routine Parse Escape Sequence
constant integer Commands = 9
constant string(31) array Command Text(0:Commands) =
"noDoubleBuffer",
"doubleBuffer",
"suffixLength",
"turnaround",
"goodResponse",
"badResponse",
"reqSeq",
"maxWait",
"wait",
"disDel"
switch C(1:Commands)
integer Command, Sym, j
string(255) S
Get Symbol(Command)
unless 0 <= Command <= Commands start
Report("*Fatal error: Undefined escape command: 16_".Xbyte(Command))
stop
finish
Space
Print String(Command Text(Command))
Print Symbol('[')
-> C(Command)
C(2): !suffixLength
C(3): !turnaround
C(7): !maxWait
Get Symbol(Sym)
Write(Sym, 0)
->L
C(4): !goodResponse
C(5): !badResponse
C(6): !reqSeq
C(8): !wait
Parse Split String (S)
Print Quoted String(S)
->L
C(*): !no parameters
L: Print Symbol(']')
end
constant integer Commands = 16_f
routine Parse Parameters ( integer Command )
switch C(0:Commands)
integer Sym, j, k, x, y
string(255) S
->C(Command)
C(*): !Default, no parameters
return
C(1): !searchAddress
x = 0
for j = 1, 1, 3 cycle
Get Symbol(k)
x = Radix*x + k
repeat
Write(x, 0)
return
C(4): !penSelect
C(7): !defineRadix
C(9): !scale
Get Symbol(j)
Write(j,0); !pen number
Radix = j if Command = 7
return
C(5): !symbolString
Parse String(S)
Print Quoted String(S)
return
C(6): !symbolScale
Get Symbol(Sym)
Parse Delta(Sym, X, Y)
Print Delta(X, Y)
return
C(8): !escape
Parse Escape Sequence
return
C(16_b):!passThru
Print String("<16_")
Get Symbol(j); Get Symbol(k)
Print String(Xbyte(j&16_f<<4 ! k&16_f).">")
return
C(16_c):!circle
Get Symbol(j)
unless 0 <= j <= 3 start
Report("Invalid circle subcode 16_".Xbyte(j))
stop
finish
for j = 1, 1, 2 cycle; !Start-point, end-point
Get Symbol(Sym)
Parse Delta(Sym, X, Y)
Print Delta(X, Y)
repeat
return
C(16_d):!dash
Get Symbol(j)
if j = 0 start
Print String("on")
else if j = 1
Print String("off (solid)")
else
Report("More than 16 dash line segments") if j > 16
Print Symbol('[')
for k = 1, 1, j cycle
Get Symbol(Sym)
Parse Delta(Sym, X, Y)
Print Delta(X, Y)
repeat
Print Symbol(']')
if j&1 # 0 and Y # 0 {in last delta} start
Report("Logic error in last dash delta")
stop
finish
finish
return
C(16_e):!operMsg
Get Symbol(Sym)
if 0 <= Sym <= 5 start
Print String("plotSymbol 16_")
Get Symbol(j)
Print String(Xbyte(Sym<<4 ! j))
unless 0 <= j <= 15 start
Report("invalid plotSymbol subcommand")
stop
finish
else if 6 <= Sym <= 7
Parse String(S)
Print Quoted String(S)
else if 8 <= Sym <= 16_c
Print String("selectSymbolSet")
Write(Sym-8, 1)
else if Sym = 16_d
Print String("defineUserSymbol 16_")
Get Symbol(Sym)
Get Symbol(j)
Print String(Xbyte(Sym<<4 ! j))
Get Symbol(j); !offset-pair count
for k = 1, 1, j cycle
Get Symbol(X); Get Symbol(Y)
Print Delta(X, Y)
repeat
else if Sym = 16_e
Print String("erase")
else if Sym = 16_f
Print String("plotAnySym 16_")
Get Symbol(Sym); Get Symbol(j)
Print String(Xbyte(Sym<<4 ! j))
else
Report("Invalid subcode 16_".Xbyte(Sym))
stop
finish
return
end
constant string(31) array Command(0:Commands) =
"noOp",
"searchAddress",
"penDown",
"penUp",
"penSelect",
"symbolString",
"symbolScale",
"defineRadix",
"escape",
"scale",
"pause",
"passThru",
"circle",
"dash",
"operMsg",
"endOfPlot"
integer j, k, x, y
integer Sym; !Current input byte
open input (1, cliparam)
Select Output(Decode Stream)
cycle; !Main loop: process command bytes
Get Symbol(Sym); !Bias has already been removed.
continue if Sym = 0; !Completely ignore noops
unless 16_0 <= Sym <= 16_3f start
Report("*Fatal error: undefined command code: 16_".Xbyte(Sym))
stop
finish
if Sym > 16_f start; !Delta Command
Print String("delta ")
Parse Delta(Sym, X, Y)
Print Delta(X, Y)
else
Print String(Command(Sym))
Print Symbol('('); !Followed by command parameters
Parse Parameters(Sym)
Print Symbol(')')
finish
Newline
repeat
endofprogram