503 lines
15 KiB
Plaintext
503 lines
15 KiB
Plaintext
|
******************************************************************************
|
||
|
|
*
|
||
|
|
* WK1.EXPORT - Generate LOTUS WK1 format file from &SAVEDLISTS& entry.
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 07/22/92 9064 WLC Initial Release.
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* LOTUS WK1 FORMAT SUMMARY:
|
||
|
|
*
|
||
|
|
* The LOTUS 1-2-3 WK1 format consists of a series of "records" as
|
||
|
|
* defined by LOTUS. The records which are required for the
|
||
|
|
* proper export of UniVerse data are:
|
||
|
|
*
|
||
|
|
* BOF - Beginning of File
|
||
|
|
* WINDOW1 - Part of Worksheet descriptor area
|
||
|
|
* COLW1 - Part of Worksheet descriptor area
|
||
|
|
* HIDCOL1 - Part of Worksheet descriptor area
|
||
|
|
* INTEGER - Used for integers (-32768...32767)
|
||
|
|
* NUMBER - Used for floating point numbers
|
||
|
|
* (anything that doesn't fit in INTEGER format)
|
||
|
|
* LABEL - Used for text fields
|
||
|
|
* EOF - End of File
|
||
|
|
*
|
||
|
|
* All "records" have the following format:
|
||
|
|
*
|
||
|
|
* ---------------------------------
|
||
|
|
* | Record Header | Record Body...
|
||
|
|
* |--------------------------------
|
||
|
|
* | 1 | 2 | 3 | 4 | | | |...
|
||
|
|
* |---------------|----------------
|
||
|
|
* | code | len | data...
|
||
|
|
* ---------------------------------
|
||
|
|
*
|
||
|
|
* Each record consists of a Record Header and a Record Body.
|
||
|
|
* The Record Header is 4 bytes: 2 byte code, 2 byte length.
|
||
|
|
* The code designates the type of record being stored.
|
||
|
|
* The length specifies the length of the Record Body.
|
||
|
|
* The Record Body varies in length and content depending on
|
||
|
|
* the type of record being stored.
|
||
|
|
*
|
||
|
|
* For more information, please refer to the "Lotus File Formats
|
||
|
|
* for 1-2-3 Symphony & Jazz" by Lotus Books.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
SUBROUTINE WK1.EXPORT(return.code)
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE UVEXPORT.H
|
||
|
|
|
||
|
|
return.code = 0
|
||
|
|
DONE = 0
|
||
|
|
BUFFER=''
|
||
|
|
|
||
|
|
* Write BOF
|
||
|
|
data = '0000':'0002':'0406'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
GOSUB Gen.Header
|
||
|
|
GOSUB Write.Buffer
|
||
|
|
IF return.code THEN RETURN
|
||
|
|
|
||
|
|
GOSUB Process.Data
|
||
|
|
IF return.code THEN RETURN
|
||
|
|
|
||
|
|
* Write EOF
|
||
|
|
data = '0001':'0000'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
DONE = 1
|
||
|
|
GOSUB Write.Buffer
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
****************************************************************************
|
||
|
|
* Write.Buffer:
|
||
|
|
* As data is added to the BUFFER variable, it is written out by
|
||
|
|
* Write.Buffer. Care is taken not to write over a swap boundary by
|
||
|
|
* making sure we write an even number of bytes, and put the remainder
|
||
|
|
* back in BUFFER for the next write.
|
||
|
|
*****************************************************************************
|
||
|
|
Write.Buffer:
|
||
|
|
IF BUFFER = '' THEN RETURN
|
||
|
|
sav = ''
|
||
|
|
IF NOT(DONE) THEN
|
||
|
|
eod = LEN(BUFFER)
|
||
|
|
IF MOD(eod,2) = 1 THEN
|
||
|
|
sav = BUFFER[eod,1]
|
||
|
|
BUFFER = BUFFER[1,eod-1]
|
||
|
|
END
|
||
|
|
END
|
||
|
|
WRITEBLK BUFFER ON SEQ.result ELSE return.code=WRITE.ERR; RETURN
|
||
|
|
BUFFER = sav
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
**************************************************************************
|
||
|
|
* Process.Data:
|
||
|
|
* Go through the &SAVEDLISTS& data one field at a time, skipping to
|
||
|
|
* the next record after reading each field. Re-open the file when
|
||
|
|
* you reach the end, until you have processed all fields. Keep track
|
||
|
|
* of the number of values present in each record so that normalization
|
||
|
|
* can be done if need be.
|
||
|
|
***************************************************************************
|
||
|
|
Process.Data:
|
||
|
|
this.record = 1
|
||
|
|
this.field = 1
|
||
|
|
mv.row = 4
|
||
|
|
LOOP
|
||
|
|
WHILE (this.field <= fcount)
|
||
|
|
num.done += 1
|
||
|
|
record.num = INT((num.done / fcount) + .5)
|
||
|
|
new.bar = INT((num.done / num.records) * 50)
|
||
|
|
IF new.bar > old.bar AND interactive THEN
|
||
|
|
PRINT @(15,10):
|
||
|
|
CALL *INVERSE.B(1)
|
||
|
|
PRINT SPACE(new.bar):
|
||
|
|
CALL *INVERSE.B(0)
|
||
|
|
old.bar = new.bar
|
||
|
|
END
|
||
|
|
|
||
|
|
mv.count = 1 ;* Keep track of the highest number of values.
|
||
|
|
* Advance to this.field and set data to it's contents
|
||
|
|
FOR fld = 1 TO this.field
|
||
|
|
READSEQ cell FROM SEQ.exp ELSE
|
||
|
|
this.record = 1
|
||
|
|
this.field += 1
|
||
|
|
mv.row = 4
|
||
|
|
CLOSESEQ SEQ.exp
|
||
|
|
OPENSEQ "&SAVEDLISTS&",saved.list TO SEQ.exp ELSE return.code = OPEN.ERR; RETURN
|
||
|
|
GOTO next.field
|
||
|
|
END
|
||
|
|
vcount = COUNT(cell,@VM)+1
|
||
|
|
IF vcount > mv.count THEN mv.count = vcount
|
||
|
|
NEXT fld
|
||
|
|
|
||
|
|
* Advance to next record
|
||
|
|
FOR fld = this.field+1 TO fcount
|
||
|
|
READSEQ skipit FROM SEQ.exp ELSE return.code = READ.ERR; RETURN
|
||
|
|
vcount = COUNT(skipit,@VM)+1
|
||
|
|
IF vcount > mv.count THEN mv.count = vcount
|
||
|
|
NEXT fld
|
||
|
|
|
||
|
|
GOSUB Write.Cell
|
||
|
|
|
||
|
|
this.record += 1
|
||
|
|
|
||
|
|
next.field:
|
||
|
|
|
||
|
|
IF LEN(BUFFER) > 2000 THEN GOSUB Write.Buffer; IF return.code THEN RETURN
|
||
|
|
REPEAT
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
****************************************************************************
|
||
|
|
* Write.Cell:
|
||
|
|
* Loop through the values of the data up to the highest number of values
|
||
|
|
* contained in the current data record. If we are normalizing, replicate
|
||
|
|
* the single valued data for the total number of values. Otherwise,
|
||
|
|
* write an empty cell in subsequent rows for the single values.
|
||
|
|
* Multi-valued data is not replicated when it contains less values than
|
||
|
|
* the max for this record.
|
||
|
|
*****************************************************************************
|
||
|
|
Write.Cell:
|
||
|
|
vcount = count(cell,@VM)
|
||
|
|
FOR value = 1 TO mv.count
|
||
|
|
IF vcount THEN
|
||
|
|
this.value = value
|
||
|
|
END ELSE this.value = 1
|
||
|
|
IF cell#'' THEN
|
||
|
|
cell.out = OCONV(cell<1,this.value>, conv.code<this.field>)
|
||
|
|
END ELSE
|
||
|
|
cell.out = cell
|
||
|
|
END
|
||
|
|
column = this.field - 1
|
||
|
|
rec.ix = this.field + field.start - 1
|
||
|
|
IF record<rec.ix,FTYPE> = STR.CODE THEN
|
||
|
|
format = "L"
|
||
|
|
END ELSE
|
||
|
|
format = record<rec.ix,FPLACES>
|
||
|
|
END
|
||
|
|
CODE = record<rec.ix,FTYPE>
|
||
|
|
buff = mv.row:@FM:column:@FM:cell.out:@FM:format
|
||
|
|
mv.row += 1
|
||
|
|
GOSUB FILL.BUFFER
|
||
|
|
IF NOT(normalize) AND NOT(vcount) THEN cell=""
|
||
|
|
IF normalize AND (single.multi<this.field> = "M") AND (value > vcount) THEN cell=""
|
||
|
|
NEXT value
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
****************************************************************************
|
||
|
|
* FILL.BUFFER:
|
||
|
|
* Given the CODE value, generate either INTEGER, NUMBER or LABEL cell
|
||
|
|
* containing the data in buff.
|
||
|
|
****************************************************************************
|
||
|
|
FILL.BUFFER:
|
||
|
|
|
||
|
|
row = ICONV(buff<ROW>,'MCX')
|
||
|
|
col = ICONV(buff<COL>,'MCX')
|
||
|
|
row = FMT(row,'R%4')
|
||
|
|
col = FMT(col,'R%4')
|
||
|
|
|
||
|
|
BEGIN CASE
|
||
|
|
|
||
|
|
CASE CODE = INT.CODE
|
||
|
|
IF NOT(NUM(buff<DATA>)) THEN GOTO do.string
|
||
|
|
IF (buff<DATA> < -32768) OR (buff<DATA> > 32767) THEN GOTO do.float
|
||
|
|
data = '000D':'0007'
|
||
|
|
GOSUB SWAP
|
||
|
|
* Integer's don't have decimal palces
|
||
|
|
data = '00'
|
||
|
|
GOSUB SWAP
|
||
|
|
data = col:row:FMT(ICONV(INT(buff<DATA>),'MCX'),'R%4')
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
CASE CODE = FLOAT.CODE
|
||
|
|
do.float:
|
||
|
|
IF NOT(NUM(buff<DATA>)) THEN GOTO do.string
|
||
|
|
GOSUB FLOAT
|
||
|
|
data = col:row
|
||
|
|
GOSUB SWAP
|
||
|
|
BUFFER := float.string
|
||
|
|
|
||
|
|
CASE CODE = STR.CODE
|
||
|
|
do.string:
|
||
|
|
strlen = LEN(buff<DATA>)
|
||
|
|
* Truncate after 240 characters since it is the LOTUS limit.
|
||
|
|
IF (strlen > 240) THEN
|
||
|
|
buff<DATA> = buff<DATA>[1,240]
|
||
|
|
strlen = 240
|
||
|
|
END
|
||
|
|
|
||
|
|
* Add 7 for 1 format byte
|
||
|
|
* 2 column bytes,
|
||
|
|
* 2 row bytes,
|
||
|
|
* 1 leading format character,
|
||
|
|
* 1 terminating null
|
||
|
|
data = strlen+7
|
||
|
|
data = FMT(ICONV(data,'MCX'),'R%4')
|
||
|
|
|
||
|
|
* LABEL cell
|
||
|
|
data = '000F':data
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* Format Code:
|
||
|
|
* Protected (bit 7=1),
|
||
|
|
* Special (bit 654=111),
|
||
|
|
* Default (bit 3210=1111)
|
||
|
|
data = 'FF'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
data = col:row
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* Generate the leading format character
|
||
|
|
BEGIN CASE
|
||
|
|
CASE buff<FRMT> = 'L'
|
||
|
|
* Single Quote : Left Justification
|
||
|
|
data = '27'
|
||
|
|
CASE buff<FRMT> = 'R'
|
||
|
|
* Double Quote : Right Justification
|
||
|
|
data = '22'
|
||
|
|
CASE buff<FRMT> = 'C'
|
||
|
|
* Carrot : Center text
|
||
|
|
data = '5E'
|
||
|
|
CASE buff<FRMT> = 'P'
|
||
|
|
* Back slash : Repeat character
|
||
|
|
data = '5C'
|
||
|
|
CASE 1
|
||
|
|
* Default to Left justify
|
||
|
|
data = '27'
|
||
|
|
END CASE
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* Write each byte of data
|
||
|
|
FOR ix = 1 TO strlen
|
||
|
|
data = FMT(ICONV(SEQ(buff<DATA>[ix,1]),'MCX'),'R%2')
|
||
|
|
GOSUB SWAP
|
||
|
|
NEXT ix
|
||
|
|
|
||
|
|
* Terminate with NULL
|
||
|
|
data = '00'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
END CASE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
*****************************************************************************
|
||
|
|
* SWAP:
|
||
|
|
* Byte swap output since LOTUS always uses 80386 format
|
||
|
|
*****************************************************************************
|
||
|
|
SWAP:
|
||
|
|
outlen = LEN(data)
|
||
|
|
FOR byte.num = 1 TO outlen STEP 4
|
||
|
|
byte1 = data[byte.num,2]
|
||
|
|
byte2 = data[byte.num+2,2]
|
||
|
|
* If we have two bytes, then swap them
|
||
|
|
IF byte1 # '' AND byte2 # '' THEN
|
||
|
|
byte1 = OCONV(byte1,'MCX')
|
||
|
|
byte2 = OCONV(byte2,'MCX')
|
||
|
|
BUFFER := CHAR(byte2):CHAR(byte1)
|
||
|
|
END ELSE
|
||
|
|
IF byte1 # '' AND byte2 = '' THEN
|
||
|
|
byte1 = OCONV(byte1,'MCX')
|
||
|
|
BUFFER := CHAR(byte1)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
NEXT byte
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* FLOAT:
|
||
|
|
* Generate an IEEE floating point value from the number stored in buff.
|
||
|
|
* IEEE specifies a 64 bit representation for floating point which
|
||
|
|
* consists of:
|
||
|
|
*
|
||
|
|
* 1 sign bit (bit 63) 0 = +, 1 = -
|
||
|
|
* 11 exponent bits (bit 62 - 52) 2^(exponent - 1023)
|
||
|
|
* 52 fraction bits (bit 51 - 0) With implied leading 1
|
||
|
|
*
|
||
|
|
* The 8 bytes of the floating point result are stored in REVERSE order
|
||
|
|
* (low-to-high as addresses ascend) This is not to be confused with
|
||
|
|
* the 80386 byte swapping. Floating point values are not swapped, but
|
||
|
|
* reversed.
|
||
|
|
*
|
||
|
|
******************************************************************************
|
||
|
|
FLOAT:
|
||
|
|
* NUMBER Record
|
||
|
|
data = '000E':'000D'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* write decimal places
|
||
|
|
data = buff<FRMT>
|
||
|
|
IF data = '' THEN data = 2 ELSE IF (data < 0) OR (data > 15) THEN data = 0
|
||
|
|
data = FMT(data,'R%2')
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
float = buff<DATA>
|
||
|
|
IF float < 0 THEN sign = 2048 ELSE sign = 0
|
||
|
|
data = ABS(float)
|
||
|
|
power = 0
|
||
|
|
float = ''
|
||
|
|
IF data # 0 THEN
|
||
|
|
IF data < 1 THEN
|
||
|
|
* value is between 0 and 1
|
||
|
|
LOOP
|
||
|
|
power -= 1
|
||
|
|
WHILE (2**power > data) DO
|
||
|
|
REPEAT
|
||
|
|
END ELSE
|
||
|
|
LOOP
|
||
|
|
WHILE (2**power <= data) DO
|
||
|
|
power += 1
|
||
|
|
REPEAT
|
||
|
|
power -= 1
|
||
|
|
END
|
||
|
|
|
||
|
|
* reduce the number to the fractional part remaining
|
||
|
|
number = (data/2**power)-1
|
||
|
|
IF power > 1024 THEN power = 1024
|
||
|
|
power += 1023
|
||
|
|
|
||
|
|
byte = 0
|
||
|
|
addon = 16
|
||
|
|
nibble = 4
|
||
|
|
BIT = 0
|
||
|
|
fraction = ''
|
||
|
|
* Now form 52-bit fraction field...
|
||
|
|
LOOP
|
||
|
|
WHILE (BIT <= 51) DO
|
||
|
|
addon = addon/2
|
||
|
|
number += number
|
||
|
|
int.portion = INT(number)
|
||
|
|
IF MOD(int.portion,2) THEN
|
||
|
|
byte += addon
|
||
|
|
END
|
||
|
|
IF MOD(BIT+1,nibble)=0 THEN
|
||
|
|
fraction := ICONV(byte,'MCX')
|
||
|
|
byte = 0
|
||
|
|
addon = 16
|
||
|
|
END
|
||
|
|
BIT += 1
|
||
|
|
REPEAT
|
||
|
|
END ELSE fraction = 0
|
||
|
|
|
||
|
|
float = ICONV(sign+power,'MCX'):fraction
|
||
|
|
len.float = LEN(float)
|
||
|
|
float := STR('0',16-len.float)
|
||
|
|
float.string = ""
|
||
|
|
* format float.string in character format, reversing the order of bytes
|
||
|
|
FOR B = 1 TO 16 STEP 2
|
||
|
|
b = CHAR(OCONV(float[B,2], 'MCX'))
|
||
|
|
float.string = b:float.string
|
||
|
|
NEXT B
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
*
|
||
|
|
* Generate the LOTUS 123 header for the .WK1 format as specified
|
||
|
|
* in the Lotus File Formats for 1-2-3 Symphony & Jazz publication
|
||
|
|
* distributed by lotus Books.
|
||
|
|
*
|
||
|
|
*************************************************************************
|
||
|
|
Gen.Header:
|
||
|
|
row = 0
|
||
|
|
|
||
|
|
*************************************************
|
||
|
|
* WINDOW1 Record consist of :
|
||
|
|
* code, length, cursor column, cursor row,
|
||
|
|
* format byte, unused, column/row defaults
|
||
|
|
*************************************************
|
||
|
|
|
||
|
|
* code, length
|
||
|
|
data = '0007':'0020'
|
||
|
|
* cursor column, cursor row (0,0)
|
||
|
|
data := '0000':'0000'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* Format Byte:
|
||
|
|
* Protected: (bit 7=1)
|
||
|
|
* Fixed: (bit 654=0)
|
||
|
|
* Decimal places: (bit 3210=2)
|
||
|
|
* Resulting in: 1000 0010 (82 hex)
|
||
|
|
data = '82'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* unused byte
|
||
|
|
data = '00'
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* Now for the column/row defaults
|
||
|
|
data = '0009' ;* default column width
|
||
|
|
data := '0006' ;* # columns on screen
|
||
|
|
data := '0014' ;* # rows on screen
|
||
|
|
data := '0000' ;* left column
|
||
|
|
data := '0000' ;* top row
|
||
|
|
data := '0000' ;* number of title columns
|
||
|
|
data := '0000' ;* number of title rows
|
||
|
|
data := '0000' ;* left title column
|
||
|
|
data := '0000' ;* left title row
|
||
|
|
data := '0000' ;* top left column
|
||
|
|
data := '0000' ;* top left row
|
||
|
|
data := '00FF' ;* columns in window
|
||
|
|
data := '0000' ;* unused
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* Generate a COLW1 Record for each field to be written
|
||
|
|
* containing the column spacing for that field
|
||
|
|
column = 0
|
||
|
|
FOR fld = 1 TO fcount
|
||
|
|
IF (LEN(display<fld>) > width<fld>) THEN
|
||
|
|
col.width = ICONV(LEN(display<fld>)+1, 'MCX')
|
||
|
|
END ELSE
|
||
|
|
col.width = ICONV(width<fld>+1,'MCX')
|
||
|
|
END
|
||
|
|
col.width = FMT(col.width,'R%2')
|
||
|
|
temp = ICONV(column,'MCX')
|
||
|
|
temp = FMT(temp,'R%4')
|
||
|
|
* COLW1 Record:
|
||
|
|
data = '0008':'0003':temp:col.width
|
||
|
|
GOSUB SWAP
|
||
|
|
column += 1
|
||
|
|
NEXT fld
|
||
|
|
|
||
|
|
* HIDCOL1 Record: all columns have hidden columns turned off
|
||
|
|
* each bit of the 32 bytes represents a single column.
|
||
|
|
data = '0064':'0020':STR('00',32)
|
||
|
|
GOSUB SWAP
|
||
|
|
|
||
|
|
* Inform FILL.BUFFER that strings are to be generated...
|
||
|
|
CODE = STR.CODE
|
||
|
|
|
||
|
|
* Write out the title of the spreadsheet centered in center column
|
||
|
|
column = INT(fcount/2)
|
||
|
|
buff = row:@FM:column:@FM:record<DESCRIPTION>:@FM:'C'
|
||
|
|
GOSUB FILL.BUFFER
|
||
|
|
row += 2
|
||
|
|
|
||
|
|
* Set up the column headings for each field using the DICT display name
|
||
|
|
FOR f = 0 TO fcount-1
|
||
|
|
IF record<f+field.start,FTYPE> = STR.CODE THEN format="L" ELSE format="R"
|
||
|
|
buff = row:@FM:f:@FM:display<f+1>:@FM:format
|
||
|
|
GOSUB FILL.BUFFER
|
||
|
|
NEXT f
|
||
|
|
row += 1
|
||
|
|
|
||
|
|
* Underline the headings
|
||
|
|
FOR f = 0 TO fcount-1
|
||
|
|
buff = row:@FM:f:@FM:'-':@FM:'P'
|
||
|
|
GOSUB FILL.BUFFER
|
||
|
|
NEXT f
|
||
|
|
row += 1
|
||
|
|
RETURN
|