******************************************************************************
*
*	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