diff options
Diffstat (limited to 'bwb_prn.c')
-rw-r--r-- | bwb_prn.c | 2973 |
1 files changed, 2973 insertions, 0 deletions
diff --git a/bwb_prn.c b/bwb_prn.c new file mode 100644 index 0000000..25f7a4f --- /dev/null +++ b/bwb_prn.c @@ -0,0 +1,2973 @@ +/*************************************************************** + + bwb_prn.c Print and Error-Handling Commands + for Bywater BASIC Interpreter + + Copyright (c) 1993, Ted A. Campbell + Bywater Software + + email: tcamp@delphi.com + + Copyright and Permissions Information: + + All U.S. and international rights are claimed by the author, + Ted A. Campbell. + + This software is released under the terms of the GNU General + Public License (GPL), which is distributed with this software + in the file "COPYING". The GPL specifies the terms under + which users may copy and use the software in this distribution. + + A separate license is available for commercial distribution, + for information on which you should contact the author. + +***************************************************************/ + +/*---------------------------------------------------------------*/ +/* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */ +/* 11/1995 (eidetics@cerf.net). */ +/* */ +/* Those additionally marked with "DD" were at the suggestion of */ +/* Dale DePriest (daled@cadence.com). */ +/* */ +/* Version 3.00 by Howard Wulf, AF5NE */ +/* */ +/* Version 3.10 by Howard Wulf, AF5NE */ +/* */ +/* Version 3.20 by Howard Wulf, AF5NE */ +/* */ +/*---------------------------------------------------------------*/ + + + +#include "bwbasic.h" + +static int buff_read_using (char *buffer, int *position, char *format_string, + int format_length); +static LineType *bwb_mat_dump (LineType * l, int IsWrite); +static int bwb_print_at (LineType * l); +static void CleanNumericString (char *prnbuf, int RemoveDot); +static int CountDigits (char *Buffer); +static LineType *D71_PUT (LineType * l); +static LineType *file_write_matrix (LineType * l, char delimit); +static LineType *H14_PUT (LineType * Line); +static void internal_print (LineType * l, int IsCSV); +static int is_magic_number (char *buffer); +static int is_magic_string (char *buffer); +static int line_read_using (LineType * l, char *format_string, + int format_length); +static void next_zone (void); +static int parse_file_number (LineType * l); +static void print_using_number (char *buffer, int *position, VariantType * e); +static void print_using_string (char *buffer, int *position, VariantType * e); +static void print_using_variant (char *buffer, int *position, VariantType * e, + int IsCSV); +static LineType *S70_PUT (LineType * l); +static void xputc1 (char c); +static void xputc2 (char c); +static void xputs (char *buffer); + + +/* +We try to allow as many legacy PRINT USING formats as reasonable. +Many legacy PRINT USING formats are incompatible with one another. +For example: +1) some use '%' for strings, others use '%' for numbers, others consider '%' as a lieral. +2) some count a leading or traling signs in the width, while others do not. +3) when a value requires more digits than the assigned width: + a) some truncate the displayed value to the width, + b) some expand the width, + c) some print a number of '%' or '*', and + d) some halt processing. +There is no perfect solution that will work for all possible dialects. +*/ + + +#define PrintUsingNumberDigit My->CurrentVersion->OptionUsingDigit /* Digit placeholder, usually '#' */ +#define PrintUsingNumberComma My->CurrentVersion->OptionUsingComma /* Comma, such as thousands, usually ',' */ +#define PrintUsingNumberPeriod My->CurrentVersion->OptionUsingPeriod /* Period, such as dollars and cents, usually '.' */ +#define PrintUsingNumberPlus My->CurrentVersion->OptionUsingPlus /* Plus sign, positive value, usually '+' */ +#define PrintUsingNumberMinus My->CurrentVersion->OptionUsingMinus /* Minus sign, negative value, usually '-' */ +#define PrintUsingNumberExponent My->CurrentVersion->OptionUsingExrad /* Exponential format, usually '^' */ +#define PrintUsingNumberDollar My->CurrentVersion->OptionUsingDollar /* Currency symbol, usually '$' */ +#define PrintUsingNumberFiller My->CurrentVersion->OptionUsingFiller /* Print filler, such as checks, usually '*' */ +#define PrintUsingLiteral My->CurrentVersion->OptionUsingLiteral /* The next char is a literal, usually '_' */ +#define PrintUsingStringFirst My->CurrentVersion->OptionUsingFirst /* The first character of the string, usually '!' */ +#define PrintUsingStringAll My->CurrentVersion->OptionUsingAll /* Print the entire string, usually '&' */ +#define PrintUsingStringLength My->CurrentVersion->OptionUsingLength /* Print a substring, usually '%' */ + + +/* +** +** ZoneChar is a MAGIC character code used by file_write_matrix() to request printing by zones. +** ZoneChar can be any character, other than NulChar, that the user will not use as a literal delimiter. +** The user is allowed to specify CHR$(9), '\t', as a literal delimiter. +** +*/ +#define ZoneChar 0x01 /* an unlikely literal delimiter */ + + +int +is_empty_string (char *Buffer) +{ + + + if (Buffer == NULL) + { + return TRUE; + } + while (*Buffer == ' ') + { + Buffer++; + } + if (*Buffer == NulChar) + { + return TRUE; + } + return FALSE; +} + + +FileType * +find_file_by_name (char *FileName) +{ + FileType *F; + + if (is_empty_string (FileName)) + { + /* the rules for Console and Printer vary by command */ + return NULL; + } + /* search the list of OPEN files */ + assert( My != NULL ); + for (F = My->FileHead; F != NULL; F = F->next) + { + assert( F != NULL ); + if (F->DevMode == DEVMODE_CLOSED) + { + } + else if (F->FileName == NULL) + { + } + else if (bwb_stricmp (F->FileName, FileName) == 0) + { + /* FOUND */ + return F; + } + } + /* NOT FOUND */ + return NULL; +} + + +FileType * +find_file_by_number (int FileNumber) +{ + FileType *F; + + + /* handle MAGIC file numbers */ + if (FileNumber <= 0) + { + /* the rules for Console and Printer vary by command */ + return NULL; + } + /* search the list of OPEN files */ + assert( My != NULL ); + for (F = My->FileHead; F != NULL; F = F->next) + { + assert( F != NULL ); + if (F->DevMode != DEVMODE_CLOSED) + { + if (F->FileNumber == FileNumber) + { + /* FOUND */ + return F; + } + } + } + /* NOT FOUND */ + return NULL; +} + + +FileType * +file_new (void) +{ + /* search for an empty slot. If not found, add a new slot. */ + FileType *F; + + assert( My != NULL ); + for (F = My->FileHead; F != NULL; F = F->next) + { + assert( F != NULL ); + if (F->DevMode == DEVMODE_CLOSED) + { + /* FOUND */ + return F; + } + } + /* NOT FOUND */ + if ((F = (FileType *) calloc (1, sizeof (FileType))) == NULL) + { + WARN_OUT_OF_MEMORY; + return NULL; + } + assert( F != NULL ); + F->next = My->FileHead; + My->FileHead = F; + return F; +} + + +void +file_clear (FileType * F) +{ + /* clean up a file slot that is no longer needed */ + + assert (F != NULL); + + clear_virtual_by_file (F->FileNumber); + F->FileNumber = 0; + F->DevMode = DEVMODE_CLOSED; /* DEVMODE_ item */ + F->width = 0; /* width for OUTPUT and APPEND; reclen for RANDOM; not used for INPUT or BINARY */ + F->col = 0; /* current column for OUTPUT and APPEND */ + F->row = 0; /* current row for OUTPUT and APPEND */ + F->EOF_LineNumber = 0; /* CBASIC-II: IF END # filenumber THEN linenumber */ + F->delimit = NulChar; /* DELIMIT for READ and WRITE */ + if (F->FileName != NULL) + { + free (F->FileName); + F->FileName = NULL; + } + if (F->cfp != NULL) + { + bwb_fclose (F->cfp); + F->cfp = NULL; + } + if (F->buffer != NULL) + { + free (F->buffer); + F->buffer = NULL; + } + +} + +int +file_next_number (void) +{ + int FileNumber; + FileType *F; + + + FileNumber = 0; + assert( My != NULL ); + for (F = My->FileHead; F != NULL; F = F->next) + { + assert( F != NULL ); + if (F->DevMode != DEVMODE_CLOSED) + { + if (F->FileNumber > FileNumber) + { + FileNumber = F->FileNumber; + } + } + } + /* 'FileNumber' is the highest FileNumber that is currently open */ + FileNumber++; + return FileNumber; +} + + + +/*************************************************************** + + FUNCTION: bwx_putc() + + DESCRIPTION: This function outputs a single character + to the default output device. + +***************************************************************/ + +static void +CleanNumericString (char *prnbuf, int RemoveDot) +{ + /* remove trailing zeroes */ + char *E; + char *D; + + assert (prnbuf != NULL); + + E = bwb_strchr (prnbuf, 'E'); + if (E == NULL) + { + E = bwb_strchr (prnbuf, 'e'); + } + if (E) + { + /* SCIENTIFIC == SCALED notation */ + /* trim leading zeroes in exponent */ + char *F; + char *G; + + F = E; + while (bwb_isalpha (*F)) + { + F++; + } + while (*F == '+' || *F == '-') + { + /* skip sign */ + F++; + } + G = F; + while (*G == '0' || *G == ' ') + { + /* skip leading zeroes or spaces */ + G++; + } + if (G > F) + { + bwb_strcpy (F, G); + } + G = NULL; /* no longer valid */ + *E = NulChar; /* for bwb_strlen() */ + } + D = bwb_strchr (prnbuf, '.'); + if (D) + { + int N; + + N = bwb_strlen (D); + if (N > 1) + { + int M; + + N--; + M = N; + while (D[N] == '0') + { + /* remove trailing zeroes */ + D[N] = '_'; + N--; + } + if (RemoveDot) + { + if (E) + { + /* SCIENTIFIC == SCALED notation */ + /* do NOT remove '.' */ + } + else + { + /* NORMAL == UNSCALED notation */ + /* remove trailing '.' */ + /* this will only occur for integer values */ + while (D[N] == '.') + { + /* _###. POSITIVE INTEGER */ + /* -###. NEGATIVE INTEGER */ + D[N] = '_'; + N--; + } + } + } + if (N < M) + { + if (E) + { + /* SCIENTIFIC == SCALED notation */ + *E = 'E'; + E = NULL; + } + N++; + /* if INTEGER, then N == 0, else N > 0 */ + M++; + /* if SCIENTIFIC, then *M == 'E' else *M == NulChar */ + bwb_strcpy (&(D[N]), &(D[M])); + } + } + } + if (E) + { + /* SCIENTIFIC == SCALED notation */ + *E = 'E'; + E = NULL; + } + if (prnbuf[1] == '0' && prnbuf[2] == '.') + { + /* _0.### POSITIVE FRACTION ==> _.### */ + /* -0.### NEGATIVE FRACTION ==> -.### */ + bwb_strcpy (&(prnbuf[1]), &(prnbuf[2])); + } + if (prnbuf[1] == '.' && prnbuf[2] == 'E') + { + /* _.E POSITIVE ZERO ==> _0 */ + /* -.E NEGATIVE ZERO ==> _0 */ + bwb_strcpy (prnbuf, " 0"); + } +} + +static int +CountDigits (char *Buffer) +{ + int NumDigits; + char *P; + + assert (Buffer != NULL); + + + /* determine the number of significant digits */ + NumDigits = 0; + P = Buffer; + while (*P) + { + if (bwb_isalpha (*P)) + { + /* 'E', 'e', and so on. */ + break; + } + if (bwb_isdigit (*P)) + { + NumDigits++; + } + P++; + } + return NumDigits; +} + +extern void +FormatBasicNumber (DoubleType Input, char *Output /* [ NUMLEN ] */ ) +{ + /******************************************************************************* + + This is essentially sprintf( Output, "%g", Input ), + except the rules for selecting between "%e", "%f", and "%d" are different. + + The C rules depend upon the value of the exponent. + The BASIC rules depend upon the number of significant digits. + + The results of this routine have been verified by the NBS2 test suite, so... + + THINK VERY CAREFULLY BEFORE MAKING ANY CHANGES TO THIS ROUTINE. + + *******************************************************************************/ + char *E; + + assert (Output != NULL); + + assert( My != NULL ); + if (My->OptionScaleInteger >= 1 + && My->OptionScaleInteger <= My->OptionDigitsInteger) + { + /* round */ + DoubleType Scale; + Scale = pow (10, My->OptionScaleInteger); + assert( Scale != 0 ); + Input = bwb_rint (Input * Scale) / Scale; + } + /* print in scientific form first, to determine exponent and significant digits */ + sprintf (Output, "% 1.*E", My->OptionDigitsInteger - 1, Input); + E = bwb_strchr (Output, 'E'); + if (E == NULL) + { + E = bwb_strchr (Output, 'e'); + } + if (E) + { + /* valid */ + int Exponent; + int NumDigits; + int DisplayDigits; + int zz; + char *F; /* pointer to the exponent's value */ + F = E; + while (bwb_isalpha (*F)) + { + F++; + } + Exponent = atoi (F); + CleanNumericString (Output, FALSE); + NumDigits = CountDigits (Output); + DisplayDigits = MIN (NumDigits, My->OptionDigitsInteger); + zz = MAX (Exponent, DisplayDigits - Exponent - 2); + if (zz >= My->OptionDigitsInteger) + { + /* SCIENTIFIC */ + sprintf (Output, "%# 1.*E", DisplayDigits - 1, Input); + } + else if (Input == (int) Input) + { + /* INTEGER */ + sprintf (Output, "% *d", DisplayDigits, (int) Input); + } + else + { + /* FLOAT */ + int Before; /* number of digits before the '.' */ + int After; /* number of digits after the '.' */ + + Before = Exponent + 1; + if (Before < 0) + { + Before = 0; + } + After = My->OptionDigitsInteger - Before; + if (After < 0) + { + After = 0; + } + sprintf (Output, "%# *.*f", Before, After, Input); + } + CleanNumericString (Output, FALSE); + } + else + { + /* ERROR, NAN, INFINITY, ETC. */ + } +} + + + +LineType * +bwb_LPRINT (LineType * l) +{ + int IsCSV; + + assert (l != NULL); + + assert( My != NULL ); + assert( My->SYSPRN != NULL ); + My->CurrentFile = My->SYSPRN; + IsCSV = FALSE; + internal_print (l, IsCSV); + return (l); +} + + +/*************************************************************** + + FUNCTION: bwb_print() + + DESCRIPTION: This function implements the BASIC PRINT + command. + + SYNTAX: PRINT [# device-number,][USING format-string$;] expressions... + +***************************************************************/ + + +static int +bwb_print_at (LineType * l) +{ + int position; + int r; + int c; + + assert (l != NULL); + + + position = 0; + r = 0; + c = 0; + if (line_read_integer_expression (l, &position)) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + return FALSE; + } + + if (line_skip_seperator (l)) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + return FALSE; + } + + if (position < 0) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + + + assert( My != NULL ); + assert( My->SYSOUT != NULL ); + if (My->SYSOUT->width <= 0) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + if (My->SCREEN_ROWS <= 0) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + assert( My->CurrentFile == My->SYSOUT ); + /* position is 0-based. 0 is top left, */ + assert( My->CurrentFile != NULL ); + assert( My->CurrentFile->width != 0 ); + r = position / My->CurrentFile->width; + c = position - r * My->CurrentFile->width; + while (r >= My->SCREEN_ROWS) + { + r -= My->SCREEN_ROWS; + } + r++; /* 0-based to 1-based */ + c++; /* 0-based to 1-based */ + bwx_LOCATE (r, c); + return TRUE; +} + + +static int +parse_file_number (LineType * l) +{ + /* ... # FileNumber , ... */ + int FileNumber; + + assert (l != NULL); + + + if (line_read_integer_expression (l, &FileNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + if (My->CurrentVersion->OptionVersionValue & (C77)) + { + /* + CBASIC-II: SERIAL & RANDOM file writes + PRINT # file_number ; expression [, expression] ' SERIAL write + PRINT # file_number , record_number ; expression [, expression] ' RANDOM write + */ + + if (FileNumber <= 0) + { + WARN_BAD_FILE_NUMBER; + return FALSE; + } + /* normal file */ + My->CurrentFile = find_file_by_number (FileNumber); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return FALSE; + } + + + if (line_skip_CommaChar (l) /* comma specific */ ) + { + /* + PRINT # file_number , record_number ; expression [, expression] ' RANDOM write + */ + /* get the RecordNumber */ + int RecordNumber; + + if ((My->CurrentFile->DevMode & DEVMODE_RANDOM) == 0) + { + WARN_BAD_FILE_MODE; + return FALSE; + } + if (My->CurrentFile->width <= 0) + { + WARN_FIELD_OVERFLOW; + return FALSE; + } + if (line_read_integer_expression (l, &RecordNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + if (RecordNumber <= 0) + { + WARN_BAD_RECORD_NUMBER; + return FALSE; + } + RecordNumber--; /* BASIC to C */ + /* if( TRUE ) */ + { + long offset; + offset = RecordNumber; + offset *= My->CurrentFile->width; + fseek (My->CurrentFile->cfp, offset, SEEK_SET); + } + } + if (line_is_eol (l)) + { + /* PRINT # filenum */ + /* PRINT # filenum , recnum */ + } + else if (line_skip_SemicolonChar (l) /* semicolon specific */ ) + { + /* PRINT # filenum ; */ + /* PRINT # filenum , recnum ; */ + } + else + { + WARN_SYNTAX_ERROR; + return FALSE; + } + return TRUE; + } + /* + SERIAL file writes: + PRINT # file_number + PRINT # file_number [, expression] + */ + if (FileNumber < 0) + { + My->CurrentFile = My->SYSPRN; + } + else if (FileNumber == 0) + { + My->CurrentFile = My->SYSOUT; + } + else + { + /* normal file */ + My->CurrentFile = find_file_by_number (FileNumber); + } + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return FALSE; + } + if ((My->CurrentFile->DevMode & DEVMODE_WRITE) == 0) + { + WARN_BAD_FILE_NUMBER; + return FALSE; + } + if (line_is_eol (l)) + { + /* PRINT # 2 */ + } + else if (line_skip_seperator (l)) + { + /* PRINT # 2 , ... */ + } + else + { + WARN_SYNTAX_ERROR; + return FALSE; + } + return TRUE; +} + +LineType * +bwb_PRINT (LineType * l) +{ + int IsCSV; + + assert (l != NULL); + + IsCSV = FALSE; + assert( My != NULL ); + if (My->IsPrinter == TRUE) + { + My->CurrentFile = My->SYSPRN; + } + else + { + My->CurrentFile = My->SYSOUT; + } + internal_print (l, IsCSV); + return (l); +} + +/*************************************************************** + + FUNCTION: internal_print() + + DESCRIPTION: This function implements the PRINT + command, utilizing a specified file our + output device. + +***************************************************************/ + +static int +buff_read_using (char *buffer, int *position, char *format_string, + int format_length) +{ + int p; + + assert (buffer != NULL); + assert (position != NULL); + assert (format_string != NULL); + + p = *position; + + if (buff_skip_word (buffer, &p, "USING")) + { + buff_skip_spaces (buffer, &p); /* keep this */ + if (bwb_isdigit (buffer[p])) + { + /* PRINT USING ### */ + int n; + int LineNumber; + LineType *x; + char *C; + char *F; + + n = 0; + LineNumber = 0; + x = NULL; + if (buff_read_line_number (buffer, &p, &LineNumber) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + /* check for target label */ + x = find_line_number (LineNumber); /* USING 100 */ + if (x == NULL) + { + WARN_UNDEFINED_LINE; + return FALSE; + } + /* line exists */ + if (x->cmdnum != C_IMAGE) + { + WARN_UNDEFINED_LINE; + return FALSE; + } + /* line contains IMAGE command */ + C = x->buffer; + C += x->Startpos; + F = format_string; + /* look for leading quote in IMAGE "..." */ + while (*C == ' ') + { + C++; + } + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + if (*C == My->CurrentVersion->OptionQuoteChar) + { + /* QUOTED */ + /* skip leading quote */ + C++; + while (*C != NulChar && *C != My->CurrentVersion->OptionQuoteChar) + { + /* copy format string, but not the trailing quote */ + if (n == format_length) + { + WARN_STRING_TOO_LONG; + break; + } + *F = *C; + C++; + F++; + n++; + } + /* skip trailing quote */ + } + else + { + /* UNQUOTED */ + while (*C) + { + /* copy format string verbatim */ + if (n == format_length) + { + WARN_STRING_TOO_LONG; + break; + } + *F = *C; + C++; + F++; + n++; + } + } + /* terminate format string */ + *F = NulChar; + if (buff_skip_seperator (buffer, &p) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + } + else + { + { + char *Value; + + Value = NULL; + if (buff_read_string_expression (buffer, &p, &Value) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + if (Value == NULL) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + if (bwb_strlen (Value) > format_length) + { + WARN_STRING_TOO_LONG; + Value[format_length] = NulChar; + } + bwb_strcpy (format_string, Value); + free (Value); + Value = NULL; + } + if (buff_skip_seperator (buffer, &p) == FALSE) + { + WARN_SYNTAX_ERROR; + return FALSE; + } + } + *position = p; + return TRUE; + } + return FALSE; +} + +static int +line_read_using (LineType * l, char *format_string, int format_length) +{ + assert (l != NULL); + assert (format_string != NULL); + return buff_read_using (l->buffer, &(l->position), format_string, + format_length); +} + +static void +internal_print (LineType * l, int IsCSV) +{ + /* if no arguments, simply print CR and return */ + /* 1980 PRINT , , ,"A" */ + int OutputCR; + char *format_string; + int format_length; + int format_position; + + assert (l != NULL); + + + OutputCR = TRUE; + assert( My != NULL ); + assert( My->ConsoleOutput != NULL ); + assert( MAX_LINE_LENGTH > 1 ); + format_string = My->ConsoleOutput; + format_length = MAX_LINE_LENGTH; + format_position = 0; + format_string[0] = NulChar; + + if (line_skip_FilenumChar (l)) + { + /* PRINT # file, ... */ + if (parse_file_number (l) == FALSE) + { + return; + } + assert( My->CurrentVersion != NULL ); + if (My->CurrentVersion->OptionVersionValue & (C77) + && My->CurrentFile->FileNumber > 0) + { + /* + ** + ** CBASIC-II files are CSV files. + ** + ** Strings are quoted other than PRINT USING. + ** Comma seperator writes a literal comma. + ** Semicolon seperator writes a literal comma. + ** Numbers do NOT have leading or trailing spaces. + ** + */ + IsCSV = TRUE; + } + OutputCR = TRUE; + } + else if (line_skip_AtChar (l)) + { + /* PRINT @ position, ... */ + assert( My->SYSOUT != NULL ); + My->CurrentFile = My->SYSOUT; + if (bwb_print_at (l) == FALSE) + { + return; + } + OutputCR = TRUE; + } + else if (My->CurrentVersion->OptionVersionValue & (B15|T80|HB1|HB2) + && line_skip_word (l, "AT")) + { + /* PRINT AT position, ... */ + assert( My->SYSOUT != NULL ); + My->CurrentFile = My->SYSOUT; + if (bwb_print_at (l) == FALSE) + { + return; + } + OutputCR = TRUE; + } + assert( My->CurrentFile != NULL ); + + while (line_is_eol (l) == FALSE) + { + /* LOOP THROUGH PRINT ELEMENTS */ + VariantType e; + VariantType *E; + + E = &e; + CLEAR_VARIANT (E); + if (line_skip_CommaChar (l) /* comma-specific */ ) + { + if (format_string[0]) + { + /* PRINT USING active */ + } + else if (IsCSV) + { + xputc1 (','); + } + else + { + /* tab over */ + next_zone (); + } + OutputCR = FALSE; + } + else if (line_skip_SemicolonChar (l) /* semicolon-specific */ ) + { + if (format_string[0]) + { + /* PRINT USING active */ + } + else if (IsCSV) + { + xputc1 (','); + } + else + { + /* concatenate strings */ + } + OutputCR = FALSE; + } + else if (line_read_using (l, format_string, format_length)) + { + format_position = 0; + OutputCR = TRUE; + } + else if (line_read_expression (l, E)) /* internal_print */ + { + /* resolve the string */ + if (My->IsErrorPending /* Keep This */ ) + { + /* + ** + ** this might look odd... + ** but we want to abort printing on the first warning. + ** The expression list could include a function with side-effects, + ** so any error should immediately halt further evaluation. + ** + */ + RELEASE_VARIANT (E); + return; + } + print_using_variant (format_string, &format_position, E, IsCSV); + RELEASE_VARIANT (E); + OutputCR = TRUE; + } + else + { + WARN_SYNTAX_ERROR; + return; + } + } + + if (OutputCR == TRUE) + { + /* did not end with ',' or ';' */ + xputc1 ('\n'); + } + if (My->CurrentFile == My->SYSOUT) + { + /* FOR I = 1 TO 1000: PRINT "."; : NEXT I : PRINT */ + fflush (My->SYSOUT->cfp); + } +} + + +/*************************************************************** + + FUNCTION: print_using_variant() + + DESCRIPTION: This function gets the PRINT USING + format string, returning a structure + to the format. + +***************************************************************/ +static void +print_using_number (char *buffer, int *position, VariantType * e) +{ + /* + Format a NUMBER. + 'buffer' points to the beginning of a PRINT USING format string, such as "###.##". + 'position' is the current offset in 'buffer'. + 'e' is the current expression to print. + */ + int width; + int precision; + int exponent; + char HeadChar; + char FillChar; + char CurrChar; + char ComaChar; + char TailChar; + int p; + char *tbuf; + + assert (buffer != NULL); + assert (position != NULL); + assert (e != NULL); + + + + width = 0; + precision = 0; + exponent = 0; + HeadChar = ' '; + FillChar = ' '; + CurrChar = ' '; + ComaChar = ' '; + TailChar = ' '; + assert( My != NULL ); + assert( My->ConsoleInput != NULL ); + tbuf = My->ConsoleInput; + + + p = *position; + while (IS_CHAR (buffer[p], PrintUsingNumberPlus) + || IS_CHAR (buffer[p], PrintUsingNumberMinus)) + { + HeadChar = buffer[p]; + width++; + p++; + } + while (IS_CHAR (buffer[p], PrintUsingNumberFiller) + || IS_CHAR (buffer[p], PrintUsingNumberDollar)) + { + if (IS_CHAR (buffer[p], PrintUsingNumberFiller)) + { + FillChar = PrintUsingNumberFiller; + } + else if (IS_CHAR (buffer[p], PrintUsingNumberDollar)) + { + CurrChar = PrintUsingNumberDollar; + } + width++; + p++; + } + while (IS_CHAR (buffer[p], PrintUsingNumberDigit) + || IS_CHAR (buffer[p], PrintUsingNumberComma)) + { + if (IS_CHAR (buffer[p], PrintUsingNumberComma)) + { + ComaChar = PrintUsingNumberComma; + } + width++; + p++; + } + if (IS_CHAR (buffer[p], PrintUsingNumberPeriod)) + { + while (IS_CHAR (buffer[p], PrintUsingNumberPeriod)) + { + width++; + p++; + } + while (IS_CHAR (buffer[p], PrintUsingNumberDigit)) + { + precision++; + width++; + p++; + } + } + while (IS_CHAR (buffer[p], PrintUsingNumberExponent)) + { + exponent++; + precision++; + width++; + p++; + } + while (IS_CHAR (buffer[p], PrintUsingNumberPlus) + || IS_CHAR (buffer[p], PrintUsingNumberMinus)) + { + TailChar = buffer[p]; + width++; + p++; + } + /* format the number */ + + + /* displaying both a Heading and a Trailing sign is NOT supported */ + if (TailChar == ' ') + { + /* do nothing */ + } + else + if (IS_CHAR (TailChar, PrintUsingNumberPlus) + || IS_CHAR (TailChar, PrintUsingNumberMinus)) + { + /* force the sign to be printed, so we can move it */ + HeadChar = TailChar; + } + else + { + WARN_INTERNAL_ERROR; + return; + } + + + if (HeadChar == ' ') + { + /* only display a '-' sign */ + if (exponent > 0) + { + sprintf (tbuf, "%*.*e", width, precision, e->Number); + } + else + { + sprintf (tbuf, "%*.*f", width, precision, e->Number); + } + } + else + if (IS_CHAR (HeadChar, PrintUsingNumberPlus) + || IS_CHAR (HeadChar, PrintUsingNumberMinus)) + { + /* force a leading sign '+' or '-' */ + if (exponent > 0) + { + sprintf (tbuf, "%+*.*e", width, precision, e->Number); + } + else + { + sprintf (tbuf, "%+*.*f", width, precision, e->Number); + } + } + else + { + WARN_INTERNAL_ERROR; + return; + } + + if (TailChar == ' ') + { + /* do nothing */ + } + else + if (IS_CHAR (TailChar, PrintUsingNumberPlus) + || IS_CHAR (TailChar, PrintUsingNumberMinus)) + { + /* move sign '+' or '-' to end */ + int i; + int n; + + n = bwb_strlen (tbuf); + + for (i = 0; i < n; i++) + { + if (tbuf[i] != ' ') + { + if (IS_CHAR (tbuf[i], PrintUsingNumberPlus)) + { + tbuf[i] = ' '; + if (IS_CHAR (TailChar, PrintUsingNumberPlus)) + { + /* TailChar of '+' does print a '+' */ + bwb_strcat (tbuf, "+"); + } + else if (IS_CHAR (TailChar, PrintUsingNumberMinus)) + { + /* TailChar of '-' does NOT print a '+' */ + bwb_strcat (tbuf, " "); + } + } + else if (IS_CHAR (tbuf[i], PrintUsingNumberMinus)) + { + tbuf[i] = ' '; + bwb_strcat (tbuf, "-"); + } + break; + } + } + if (tbuf[0] == ' ') + { + n = bwb_strlen (tbuf); + /* n > 0 */ + for (i = 1; i < n; i++) + { + tbuf[i - 1] = tbuf[i]; + } + tbuf[n - 1] = NulChar; + } + } + else + { + WARN_INTERNAL_ERROR; + return; + } + + + if (CurrChar == ' ') + { + /* do nothing */ + } + else if (IS_CHAR (CurrChar, PrintUsingNumberDollar)) + { + int i; + int n; + + n = bwb_strlen (tbuf); + + for (i = 0; i < n; i++) + { + if (tbuf[i] != ' ') + { + if (i > 0) + { + if (bwb_isdigit (tbuf[i])) + { + tbuf[i - 1] = CurrChar; + } + else + { + /* sign char */ + tbuf[i - 1] = tbuf[i]; + tbuf[i] = CurrChar; + } + } + break; + } + } + } + else + { + WARN_INTERNAL_ERROR; + return; + } + + if (FillChar == ' ') + { + /* do nothing */ + } + else if (IS_CHAR (FillChar, PrintUsingNumberFiller)) + { + int i; + int n; + + n = bwb_strlen (tbuf); + + for (i = 0; i < n; i++) + { + if (tbuf[i] != ' ') + { + break; + } + tbuf[i] = PrintUsingNumberFiller; + } + } + else + { + WARN_INTERNAL_ERROR; + return; + } + + if (ComaChar == ' ') + { + xputs (tbuf); + } + else if (IS_CHAR (ComaChar, PrintUsingNumberComma)) + { + int dig_pos; + int dec_pos; + int i; + int n; + int commas; + + dig_pos = -1; + dec_pos = -1; + n = bwb_strlen (tbuf); + + for (i = 0; i < n; i++) + { + if ((bwb_isdigit (tbuf[i]) != 0) && (dig_pos == -1)) + { + dig_pos = i; + } + if ((tbuf[i] == PrintUsingNumberPeriod) && (dec_pos == -1)) + { + dec_pos = i; + } + if ((dig_pos != -1) && (dec_pos != -1)) + { + break; + } + } + if (dig_pos == -1) + { + dec_pos = n; + } + if (dec_pos == -1) + { + dec_pos = n; + } + /* count the number of commas */ + commas = 0; + for (i = 0; i < n; i++) + { + if (((dec_pos - i) % 3 == 0) && (i > dig_pos) && (i < dec_pos)) + { + commas++; + } + } + /* now, actually print */ + for (i = 0; i < n; i++) + { + if (i < commas && tbuf[i] == FillChar) + { + /* + Ignore the same number of leading spaces as there are commas. + While not perfect for all possible cases, + it is usually good enough for practical purposes. + */ + } + else + { + if (((dec_pos - i) % 3 == 0) && (i > dig_pos) && (i < dec_pos)) + { + xputc1 (PrintUsingNumberComma); + } + xputc1 (tbuf[i]); + } + } + } + else + { + WARN_INTERNAL_ERROR; + return; + } + *position = p; +} + +static void +print_using_string (char *buffer, int *position, VariantType * e) +{ + /* + Format a STRING. + 'buffer' points to the beginning of a PRINT USING format string, such as "###.##". + 'position' is the current offset in 'buffer'. + 'e' is the current expression to print. + */ + int p; + char *tbuf; + + assert (buffer != NULL); + assert (position != NULL); + assert (e != NULL); + assert( My != NULL ); + assert( My->NumLenBuffer != NULL ); + + p = *position; + + if (e->VariantTypeCode == StringTypeCode) + { + tbuf = e->Buffer; + } + else + { + tbuf = My->NumLenBuffer; + FormatBasicNumber (e->Number, tbuf); + } + + if (IS_CHAR (buffer[p], PrintUsingStringFirst)) + { + /* print first character only */ + int i; + + i = 0; + if (tbuf[i] == NulChar) + { + xputc1 (' '); + } + else + { + xputc1 (tbuf[i]); + i++; + } + p++; + } + else if (IS_CHAR (buffer[p], PrintUsingStringAll)) + { + /* print entire string */ + p++; + xputs (tbuf); + } + else if (IS_CHAR (buffer[p], PrintUsingStringLength)) + { + /* print N characters or spaces */ + int i; + + i = 0; + if (tbuf[i] == NulChar) + { + xputc1 (' '); + } + else + { + xputc1 (tbuf[i]); + i++; + } + p++; + + while (buffer[p] != NulChar && buffer[p] != PrintUsingStringLength) + { + if (tbuf[i] == NulChar) + { + xputc1 (' '); + } + else + { + xputc1 (tbuf[i]); + i++; + } + p++; + } + if (IS_CHAR (buffer[p], PrintUsingStringLength)) + { + if (tbuf[i] == NulChar) + { + xputc1 (' '); + } + else + { + xputc1 (tbuf[i]); + i++; + } + p++; + } + } + *position = p; +} + +static int +is_magic_string (char *buffer) +{ + /* + for the character string pointed to 'buffer': + return TRUE if it is a MagicString sequence, + return FALSE otherwise. + */ + + assert (buffer != NULL); + + + /* 1 character sequences */ + if (IS_CHAR (buffer[0], PrintUsingStringFirst)) + { + /* "!" */ + return TRUE; + } + if (IS_CHAR (buffer[0], PrintUsingStringAll)) + { + /* "&" */ + return TRUE; + } + if (IS_CHAR (buffer[0], PrintUsingStringLength)) + { + /* "%...%" */ + return TRUE; + } + + /* 2 character sequences */ + + /* 3 character sequences */ + + return FALSE; +} + +static int +is_magic_number (char *buffer) +{ + /* + for the character string pointed to 'buffer': + return TRUE if it is a MagicNumber sequence, + return FALSE otherwise. + */ + + assert (buffer != NULL); + + /* 1 character sequences */ + if (IS_CHAR (buffer[0], PrintUsingNumberDigit)) + { + /* "#" */ + return TRUE; + } + + /* 2 character sequences */ + if (IS_CHAR (buffer[0], PrintUsingNumberFiller)) + if (IS_CHAR (buffer[1], PrintUsingNumberFiller)) + { + /* "**" */ + return TRUE; + } + if (IS_CHAR (buffer[0], PrintUsingNumberDollar)) + if (IS_CHAR (buffer[1], PrintUsingNumberDollar)) + { + /* "$$" */ + return TRUE; + } + + if (IS_CHAR (buffer[0], PrintUsingNumberPlus)) + if (IS_CHAR (buffer[1], PrintUsingNumberDigit)) + { + /* "+#" */ + return TRUE; + } + if (IS_CHAR (buffer[0], PrintUsingNumberMinus)) + if (IS_CHAR (buffer[1], PrintUsingNumberDigit)) + { + /* "-#" */ + return TRUE; + } + + /* 3 character sequences */ + if (IS_CHAR (buffer[0], PrintUsingNumberPlus)) + if (IS_CHAR (buffer[1], PrintUsingNumberFiller)) + if (IS_CHAR (buffer[2], PrintUsingNumberFiller)) + { + /* "+**" */ + return TRUE; + } + if (IS_CHAR (buffer[0], PrintUsingNumberPlus)) + if (IS_CHAR (buffer[1], PrintUsingNumberDollar)) + if (IS_CHAR (buffer[2], PrintUsingNumberDollar)) + { + /* "+$$" */ + return TRUE; + } + if (IS_CHAR (buffer[0], PrintUsingNumberMinus)) + if (IS_CHAR (buffer[1], PrintUsingNumberFiller)) + if (IS_CHAR (buffer[2], PrintUsingNumberFiller)) + { + /* "-**" */ + return TRUE; + } + if (IS_CHAR (buffer[0], PrintUsingNumberMinus)) + if (IS_CHAR (buffer[1], PrintUsingNumberDollar)) + if (IS_CHAR (buffer[2], PrintUsingNumberDollar)) + { + /* "-$$" */ + return TRUE; + } + + return FALSE; +} + +static void +print_using_variant (char *buffer, int *position, VariantType * e, int IsCSV) +{ + /* + Format an EXPRESSION. + 'buffer' points to the beginning of a PRINT USING format string, such as "###.##". + 'position' is the current offset in 'buffer'. + 'e' is the current expression to print. + */ + int IsUsed; + + assert (buffer != NULL); + assert (position != NULL); + assert (e != NULL); + assert( My != NULL ); + assert( My->NumLenBuffer != NULL ); + + /* PRINT A, B, C */ + /* PRINT USING "", A, B, C */ + /* PRINT USING "#", A, B, C */ + + IsUsed = FALSE; + if (buffer[0]) + { + /* we have a format string */ + int p; + p = *position; + + if (p > 0 && buffer[p] == NulChar) + { + /* recycle the format string */ + p = 0; + } + while (buffer[p]) + { + if (is_magic_string (&buffer[p])) + { + if (IsUsed) + { + /* stop here, ready for next string value */ + break; + } + if (e->VariantTypeCode != StringTypeCode) + { + /* we are a number value, so we cannot match a magic string */ + break; + } + /* magic and value are both string */ + print_using_string (buffer, &p, e); + IsUsed = TRUE; + } + else if (is_magic_number (&buffer[p])) + { + if (IsUsed) + { + /* stop here, ready for next number value */ + break; + } + if (e->VariantTypeCode == StringTypeCode) + { + /* we are a string value, so we cannot match a magic number */ + break; + } + /* magic and value are both number */ + print_using_number (buffer, &p, e); + IsUsed = TRUE; + } + else if (IS_CHAR (buffer[p], PrintUsingLiteral)) + { + /* print next character as literal */ + p++; + if (buffer[p] == NulChar) + { + /* PRINT USING "_" */ + xputc1 (' '); + } + else + { + /* PRINT USING "_%" */ + xputc1 (buffer[p]); + p++; + } + } + else + { + /* print this character as literal */ + /* PRINT USING "A" */ + xputc1 (buffer[p]); + p++; + } + } + *position = p; + } + + if (IsUsed == FALSE) + { + /* we did not actually print the vlue */ + if (e->VariantTypeCode == StringTypeCode) + { + /* + ** + ** PRINT A$ + ** PRINT USING "";A$ + ** PRINT USING "ABC";A$ + ** + */ + if (IsCSV) + { + xputc1 ('\"'); + xputs (e->Buffer); + xputc1 ('\"'); + } + else + { + xputs (e->Buffer); + } + } + else + { + /* + ** + ** PRINT X + ** PRINT USING "";X + ** PRINT USING "ABC";X + ** + ** [space]number[space] POSITIVE or ZERO + ** [minus]number[space] NEGATIVE + ** + **/ + char *tbuf; + + tbuf = My->NumLenBuffer; + + FormatBasicNumber (e->Number, tbuf); + + if (IsCSV) + { + char *P; + P = tbuf; + while (*P == ' ') + { + P++; + } + xputs (P); + } + else + { + xputs (tbuf); + xputc1 (' '); + } + } + } +} + +/*************************************************************** + + FUNCTION: xputs() + + DESCRIPTION: This function outputs a null-terminated + string to a specified file or output + device. + +***************************************************************/ + +static void +xputs (char *buffer) +{ + + assert (buffer != NULL); + assert( My != NULL ); + assert (My->CurrentFile != NULL); + + if (My->CurrentFile->width > 0) + { + /* check to see if the width will be exceeded */ + int n; + n = My->CurrentFile->col + bwb_strlen (buffer) - 1; + if (n > My->CurrentFile->width) + { + xputc1 ('\n'); + } + } + /* output the string */ + while (*buffer) + { + xputc1 (*buffer); + buffer++; + } +} + + +/*************************************************************** + + FUNCTION: next_zone() + + DESCRIPTION: Advance to the next print zone. + +***************************************************************/ +static void +next_zone (void) +{ + assert( My != NULL ); + assert (My->CurrentFile != NULL); + + if (My->CurrentFile->width > 0) + { + /* + ** + ** check to see if width will be exceeded + ** + */ + int LastZoneColumn; + + LastZoneColumn = 1; + while (LastZoneColumn < My->CurrentFile->width) + { + LastZoneColumn += My->OptionZoneInteger; + } + LastZoneColumn -= My->OptionZoneInteger; + + if (My->CurrentFile->col >= LastZoneColumn) + { + /* + ** + ** width will be exceeded, so advance to a new line + ** + */ + xputc1 ('\n'); + return; + } + } + /* + ** + ** advance to the next print zone + ** + */ + if ((My->CurrentFile->col % My->OptionZoneInteger) == 1) + { + xputc1 (' '); + } + while ((My->CurrentFile->col % My->OptionZoneInteger) != 1) + { + xputc1 (' '); + } +} + +/*************************************************************** + + FUNCTION: xputc1() + + DESCRIPTION: This function outputs a character to a + specified file or output device, checking + to be sure the PRINT width is within + the bounds specified for that device. + +***************************************************************/ + +static void +xputc1 (char c) +{ + assert( My != NULL ); + assert (My->CurrentFile != NULL); + + if (My->CurrentFile->width > 0) + { + /* + ** + ** check to see if width has been exceeded + ** + */ + if (c != '\n') + { + /* + ** + ** REM this should print one line, not two lines + ** WIDTH 80 + ** PRINT SPACE$( 80 ) + ** + */ + if (My->CurrentFile->col > My->CurrentFile->width) + { + xputc2 ('\n'); /* output LF */ + } + } + } + /* + ** + ** output the character + ** + */ + xputc2 (c); +} + +/*************************************************************** + + FUNCTION: xputc2() + + DESCRIPTION: This function sends a character to a + specified file or output device. + +***************************************************************/ + + +static void +xputc2 (char c) +{ + assert( My != NULL ); + assert (My->CurrentFile != NULL); + assert (My->CurrentFile->cfp != NULL); + assert( My->CurrentVersion != NULL ); + + if (c == '\n') + { + /* + ** + ** CBASIC-II: RANDOM files are padded on the right with spaces + ** + */ + if (My->CurrentVersion->OptionVersionValue & (C77)) + if (My->CurrentFile->DevMode & DEVMODE_RANDOM) + if (My->CurrentFile->width > 0) + { +#if HAVE_MSDOS + /* "\n" is converted to "\r\n" */ + while (My->CurrentFile->col < (My->CurrentFile->width - 1)) +#else /* ! HAVE_MSDOS */ + while (My->CurrentFile->col < My->CurrentFile->width) +#endif /* ! HAVE_MSDOS */ + { + fputc (' ', My->CurrentFile->cfp); + My->CurrentFile->col++; + } + } + /* + ** + ** output the character + ** + */ + fputc (c, My->CurrentFile->cfp); + /* + ** + ** NULLS + ** + */ + if (My->LPRINT_NULLS > 0) + if (My->CurrentFile == My->SYSPRN) + if (My->CurrentFile->width > 0) + { + int i; + for (i = 0; i < My->LPRINT_NULLS; i++) + { + fputc (NulChar, My->SYSPRN->cfp); + } + } + /* + ** + ** update current column position + ** + */ + My->CurrentFile->col = 1; + My->CurrentFile->row++; + return; + } + /* + ** + ** output the character + ** + */ + fputc (c, My->CurrentFile->cfp); + /* + ** + ** update current column position + ** + */ + My->CurrentFile->col++; +} + + +extern void +ResetConsoleColumn (void) +{ + assert( My != NULL ); + assert (My->SYSOUT != NULL); + + My->SYSOUT->col = 1; +} + +static LineType * +S70_PUT (LineType * l) +{ + /* PUT filename$ , value [, ...] */ + VariantType e; + VariantType *E; + + assert (l != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + assert( My->NumLenBuffer != NULL ); + + E = &e; + CLEAR_VARIANT (E); + if (line_read_expression (l, E) == FALSE) /* bwb_PUT */ + { + goto EXIT; + } + if (E->VariantTypeCode == StringTypeCode) + { + /* STRING */ + /* PUT filename$ ... */ + if (is_empty_string (E->Buffer)) + { + /* PUT "" ... is an error */ + WARN_BAD_FILE_NAME; + goto EXIT; + } + My->CurrentFile = find_file_by_name (E->Buffer); + if (My->CurrentFile == NULL) + { + /* implicitly OPEN for writing */ + My->CurrentFile = file_new (); + My->CurrentFile->cfp = fopen (E->Buffer, "w"); + if (My->CurrentFile->cfp == NULL) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + My->CurrentFile->FileNumber = file_next_number (); + My->CurrentFile->DevMode = DEVMODE_OUTPUT; + My->CurrentFile->width = 0; + /* WIDTH == RECLEN */ + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + My->CurrentFile->buffer = NULL; + if (My->CurrentFile->FileName != NULL) + { + free (My->CurrentFile->FileName); + My->CurrentFile->FileName = NULL; + } + My->CurrentFile->FileName = E->Buffer; + E->Buffer = NULL; + } + } + else + { + /* NUMBER -- file must already be OPEN */ + /* PUT filenumber ... */ + if (E->Number < 0) + { + /* "PUT # -1" is an error */ + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + if (E->Number == 0) + { + /* "PUT # 0" is an error */ + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + /* normal file */ + My->CurrentFile = find_file_by_number ((int) bwb_rint (E->Number)); + if (My->CurrentFile == NULL) + { + /* file not OPEN */ + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + } + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + if ((My->CurrentFile->DevMode & DEVMODE_WRITE) == 0) + { + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + if (line_is_eol (l)) + { + /* PUT F$ */ + /* PUT #1 */ + xputc1 ('\n'); + goto EXIT; + } + else if (line_skip_seperator (l)) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + + /* loop through elements */ + + while (line_is_eol (l) == FALSE) + { + while (line_skip_seperator (l)) + { + /* PUT F$, ,,,A,,,B,,, */ + /* PUT #1, ,,,A,,,B,,, */ + xputc1 (My->CurrentFile->delimit); + } + + if (line_is_eol (l) == FALSE) + { + /* print this item */ + + CLEAR_VARIANT (E); + if (line_read_expression (l, E) == FALSE) /* bwb_PUT */ + { + goto EXIT; + } + if (E->VariantTypeCode == StringTypeCode) + { + /* STRING */ + xputc1 (My->CurrentVersion->OptionQuoteChar); + xputs (E->Buffer); + xputc1 (My->CurrentVersion->OptionQuoteChar); + } + else + { + /* NUMBER */ + char *tbuf; + + tbuf = My->NumLenBuffer; + FormatBasicNumber (E->Number, tbuf); + xputs (tbuf); + } + RELEASE_VARIANT (E); + } + } + /* print LF */ + xputc1 ('\n'); + /* OK */ +EXIT: + RELEASE_VARIANT (E); + return (l); +} + + +static LineType * +D71_PUT (LineType * l) +{ + /* PUT # file_number [ , RECORD record_number ] */ + int file_number; + + assert (l != NULL); + assert( My != NULL ); + + file_number = 0; + if (line_skip_FilenumChar (l)) + { + /* OPTIONAL */ + } + if (line_read_integer_expression (l, &file_number) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (file_number < 1) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + My->CurrentFile = find_file_by_number (file_number); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (My->CurrentFile->DevMode != DEVMODE_RANDOM) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (My->CurrentFile->width <= 0) + { + WARN_BAD_FILE_NUMBER; + return (l); + } + if (line_is_eol (l)) + { + /* PUT # file_number */ + } + else + { + /* PUT # file_number , RECORD record_number */ + int record_number; + long offset; + + record_number = 0; + offset = 0; + if (line_skip_seperator (l) == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_skip_word (l, "RECORD") == FALSE) + { + WARN_SYNTAX_ERROR; + return (l); + } + if (line_read_integer_expression (l, &record_number) == FALSE) + { + WARN_BAD_RECORD_NUMBER; + return (l); + } + if (record_number <= 0) + { + WARN_BAD_RECORD_NUMBER; + return (l); + } + record_number--; /* BASIC to C */ + offset = record_number; + offset *= My->CurrentFile->width; + if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0) + { + WARN_BAD_RECORD_NUMBER; + return (l); + } + } + field_put (My->CurrentFile); + /* if( TRUE ) */ + { + int i; + for (i = 0; i < My->CurrentFile->width; i++) + { + char c; + c = My->CurrentFile->buffer[i]; + fputc (c, My->CurrentFile->cfp); + } + } + /* OK */ + return (l); +} + +static LineType * +H14_PUT (LineType * Line) +{ + /* PUT # FileNumber [ , RecordNumber ] ' RANDOM */ + /* PUT # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */ + int file_number; + + assert (Line != NULL); + assert( My != NULL ); + + file_number = 0; + if (line_skip_FilenumChar (Line)) + { + /* OPTIONAL */ + } + if (line_read_integer_expression (Line, &file_number) == FALSE) + { + WARN_BAD_FILE_NUMBER; + return (Line); + } + if (file_number < 1) + { + WARN_BAD_FILE_NUMBER; + return (Line); + } + My->CurrentFile = find_file_by_number (file_number); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + return (Line); + } + if (My->CurrentFile->DevMode == DEVMODE_RANDOM) + { + /* PUT # FileNumber [ , RecordNumber ] ' RANDOM */ + if (My->CurrentFile->width <= 0) + { + WARN_BAD_FILE_NUMBER; + return (Line); + } + if (line_is_eol (Line)) + { + /* PUT # file_number */ + } + else + { + /* PUT # FileNumber , RecordNumber ' RANDOM */ + int record_number; + long offset; + + record_number = 0; + offset = 0; + if (line_skip_seperator (Line) == FALSE) + { + WARN_SYNTAX_ERROR; + return (Line); + } + if (line_read_integer_expression (Line, &record_number) == FALSE) + { + WARN_BAD_RECORD_NUMBER; + return (Line); + } + if (record_number <= 0) + { + WARN_BAD_RECORD_NUMBER; + return (Line); + } + record_number--; /* BASIC to C */ + offset = record_number; + offset *= My->CurrentFile->width; + if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0) + { + WARN_BAD_RECORD_NUMBER; + return (Line); + } + } + field_put (My->CurrentFile); + /* if( TRUE ) */ + { + int i; + for (i = 0; i < My->CurrentFile->width; i++) + { + char c; + c = My->CurrentFile->buffer[i]; + fputc (c, My->CurrentFile->cfp); + } + } + /* OK */ + return (Line); + } + else if (My->CurrentFile->DevMode == DEVMODE_BINARY) + { + /* PUT # FileNumber , [ BytePosition ] , scalar [,...] ' BINARY */ + if (line_skip_seperator (Line) == FALSE) + { + WARN_SYNTAX_ERROR; + return (Line); + } + if (line_skip_seperator (Line)) + { + /* BytePosition not provided */ + } + else + { + int RecordNumber; + long offset; + + RecordNumber = 0; + offset = 0; + if (line_read_integer_expression (Line, &RecordNumber) == FALSE) + { + WARN_BAD_RECORD_NUMBER; + return (Line); + } + if (RecordNumber <= 0) + { + WARN_BAD_RECORD_NUMBER; + return (Line); + } + RecordNumber--; /* BASIC to C */ + offset = RecordNumber; + if (fseek (My->CurrentFile->cfp, offset, SEEK_SET) != 0) + { + WARN_BAD_RECORD_NUMBER; + return (Line); + } + if (line_skip_seperator (Line) == FALSE) + { + WARN_SYNTAX_ERROR; + return (Line); + } + } + do + { + VariableType *v; + + if ((v = line_read_scalar (Line)) == NULL) + { + WARN_SYNTAX_ERROR; + return (Line); + } + if (binary_get_put (v, TRUE) == FALSE) + { + WARN_SYNTAX_ERROR; + return (Line); + } + } + while (line_skip_seperator (Line)); + /* OK */ + return (Line); + } + WARN_BAD_FILE_MODE; + return (Line); +} + + +extern LineType * +bwb_PUT (LineType * Line) +{ + + assert (Line != NULL); + assert( My != NULL ); + assert( My->CurrentVersion != NULL ); + + if (My->CurrentVersion->OptionVersionValue & (S70 | I70 | I73)) + { + return S70_PUT (Line); + } + if (My->CurrentVersion->OptionVersionValue & (D71 | R86)) + { + return D71_PUT (Line); + } + if (My->CurrentVersion->OptionVersionValue & (H14)) + { + return H14_PUT (Line); + } + WARN_INTERNAL_ERROR; + return (Line); +} + + +/*************************************************************** + + FUNCTION: bwb_write() + + DESCRIPTION: This C function implements the BASIC WRITE + command. + + SYNTAX: WRITE [# device-number,] element [, element ].... + +***************************************************************/ + + +extern LineType * +bwb_WRITE (LineType * l) +{ + int IsCSV; + + assert (l != NULL); + + IsCSV = TRUE; + assert( My != NULL ); + assert( My->SYSOUT != NULL ); + My->CurrentFile = My->SYSOUT; + internal_print (l, IsCSV); + return (l); +} + +static LineType * +file_write_matrix (LineType * l, char delimit) +{ + /* MAT PRINT [ # filenumber , ] matrix [;|,] ... */ + /* MAT WRITE [ # filenumber , ] matrix [;|,] ... */ + /* MAT PUT filename$ , matrix [;|,] ... */ + /* MAT PUT filenumber , matrix [;|,] ... */ + /* Array must be 1, 2 or 3 dimensions */ + /* Array may be either NUMBER or STRING */ + + assert (l != NULL); + + do + { + VariableType *v; + char ItemSeperator; + + /* get matrix name */ + if ((v = line_read_matrix (l)) == NULL) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + + /* variable MUST be an array of 1, 2 or 3 dimensions */ + if (v->dimensions < 1) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + if (v->dimensions > 3) + { + WARN_SUBSCRIPT_OUT_OF_RANGE; + return (l); + } + /* + ** + ** This may look odd, but MAT PRINT is special. + ** The variable seperator AFTER the variable determines how the variable's values are printed. + ** The number of dimension determines: + ** a) the meaning of comma (,) and semicolon (;) + ** b) the default of row-by-row or col-by-col + ** + */ + ItemSeperator = NulChar; /* concatenate the columns */ + if (line_skip_CommaChar (l) /* comma-specific */ ) + { + /* + ** + ** force printing with the specified delimiter, + ** which is usually a Comma but can be any character. + ** + */ + ItemSeperator = delimit; /* for MAT PRINT this is forced to be a ZoneChar */ + } + else if (line_skip_SemicolonChar (l) /* semicolon-specific */ ) + { + /* + ** + ** force concatenating the columns, + ** ignoring the specified delimiter. + ** + */ + ItemSeperator = NulChar; + } + else + { + /* + ** + ** default the item seperator based upon variable's dimensions + ** + */ + switch (v->dimensions) + { + case 1: + /* by default, a one dimension array is printed row-by-row */ + ItemSeperator = '\n'; + break; + case 2: + /* by default, a two dimension array is printed col-by-col */ + ItemSeperator = delimit; + break; + case 3: + /* by default, a three dimension array is printed col-by-col */ + ItemSeperator = delimit; + break; + } + } + /* print array */ + switch (v->dimensions) + { + case 1: + { + /* + OPTION BASE 0 + DIM A(5) + ... + MAT PRINT A + ... + FOR I = 0 TO 5 + PRINT A(I) + NEXT I + ... + */ + for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0]; + v->VINDEX[0]++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + if (v->VINDEX[0] > v->LBOUND[0]) + { + switch (ItemSeperator) + { + case NulChar: + break; + case ZoneChar: + next_zone (); + break; + default: + xputc1 (ItemSeperator); + } + } + if (var_get (v, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + if (variant.VariantTypeCode == StringTypeCode) + { + xputs (variant.Buffer); + } + else + { + char *tbuf; + + tbuf = My->NumLenBuffer; + FormatBasicNumber (variant.Number, tbuf); + xputs (tbuf); + } + } + xputc1 ('\n'); + } + break; + case 2: + { + /* + OPTION BASE 0 + DIM B(2,3) + ... + MAT PRINT B + ... + FOR I = 0 TO 2 + FOR J = 0 TO 3 + PRINT B(I,J), + NEXT J + PRINT + NEXT I + ... + */ + for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0]; + v->VINDEX[0]++) + { + for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1]; + v->VINDEX[1]++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + if (v->VINDEX[1] > v->LBOUND[1]) + { + switch (ItemSeperator) + { + case NulChar: + break; + case ZoneChar: + next_zone (); + break; + default: + xputc1 (ItemSeperator); + } + } + if (var_get (v, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + if (variant.VariantTypeCode == StringTypeCode) + { + xputs (variant.Buffer); + } + else + { + char *tbuf; + + tbuf = My->NumLenBuffer; + FormatBasicNumber (variant.Number, tbuf); + xputs (tbuf); + } + } + xputc1 ('\n'); + } + } + break; + case 3: + { + /* + OPTION BASE 0 + DIM C(2,3,4) + ... + MAT PRINT C + ... + FOR I = 0 TO 2 + FOR J = 0 TO 3 + FOR K = 0 TO 4 + PRINT C(I,J,K), + NEXT K + PRINT + NEXT J + PRINT + NEXT I + ... + */ + for (v->VINDEX[0] = v->LBOUND[0]; v->VINDEX[0] <= v->UBOUND[0]; + v->VINDEX[0]++) + { + for (v->VINDEX[1] = v->LBOUND[1]; v->VINDEX[1] <= v->UBOUND[1]; + v->VINDEX[1]++) + { + for (v->VINDEX[2] = v->LBOUND[2]; v->VINDEX[2] <= v->UBOUND[2]; + v->VINDEX[2]++) + { + VariantType variant; + CLEAR_VARIANT (&variant); + + if (v->VINDEX[2] > v->LBOUND[2]) + { + switch (ItemSeperator) + { + case NulChar: + break; + case ZoneChar: + next_zone (); + break; + default: + xputc1 (ItemSeperator); + } + } + if (var_get (v, &variant) == FALSE) + { + WARN_VARIABLE_NOT_DECLARED; + return (l); + } + if (variant.VariantTypeCode == StringTypeCode) + { + xputs (variant.Buffer); + } + else + { + char *tbuf; + + tbuf = My->NumLenBuffer; + FormatBasicNumber (variant.Number, tbuf); + xputs (tbuf); + } + } + xputc1 ('\n'); + } + xputc1 ('\n'); + } + } + break; + } + /* process the next variable, if any */ + } + while (line_is_eol (l) == FALSE); + return (l); +} + +extern LineType * +bwb_MAT_PUT (LineType * l) +{ + /* MAT PUT filename$ , matrix [;|,] ... */ + /* MAT PUT filenumber , matrix [;|,] ... */ + /* Array must be 1, 2 or 3 dimensions */ + /* Array may be either NUMBER or STRING */ + VariantType x; + VariantType *X; + + assert (l != NULL); + assert( My != NULL ); + assert( My->SYSOUT != NULL ); + + My->CurrentFile = My->SYSOUT; + X = &x; + CLEAR_VARIANT (X); + if (line_read_expression (l, X) == FALSE) /* bwb_MAT_PUT */ + { + goto EXIT; + } + if (X->VariantTypeCode == StringTypeCode) + { + /* STRING */ + /* MAT PUT filename$ ... */ + if (is_empty_string (X->Buffer)) + { + /* MAT PUT "" ... is an error */ + WARN_BAD_FILE_NAME; + goto EXIT; + } + My->CurrentFile = find_file_by_name (X->Buffer); + if (My->CurrentFile == NULL) + { + /* implicitly OPEN for writing */ + My->CurrentFile = file_new (); + My->CurrentFile->cfp = fopen (X->Buffer, "w"); + if (My->CurrentFile->cfp == NULL) + { + WARN_BAD_FILE_NAME; + goto EXIT; + } + My->CurrentFile->FileNumber = file_next_number (); + My->CurrentFile->DevMode = DEVMODE_OUTPUT; + My->CurrentFile->width = 0; + /* WIDTH == RECLEN */ + My->CurrentFile->col = 1; + My->CurrentFile->row = 1; + My->CurrentFile->delimit = ','; + My->CurrentFile->buffer = NULL; + if (My->CurrentFile->FileName != NULL) + { + free (My->CurrentFile->FileName); + My->CurrentFile->FileName = NULL; + } + My->CurrentFile->FileName = X->Buffer; + X->Buffer = NULL; + } + } + else + { + /* NUMBER -- file must already be OPEN */ + /* MAT PUT filenumber ... */ + if (X->Number < 0) + { + /* "MAT PUT # -1" is an error */ + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + if (X->Number == 0) + { + /* "MAT PUT # 0" is an error */ + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + /* normal file */ + My->CurrentFile = find_file_by_number ((int) bwb_rint (X->Number)); + if (My->CurrentFile == NULL) + { + /* file not OPEN */ + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + } + RELEASE_VARIANT (X); + if (My->CurrentFile == NULL) + { + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + if ((My->CurrentFile->DevMode & DEVMODE_WRITE) == 0) + { + WARN_BAD_FILE_NUMBER; + goto EXIT; + } + if (line_skip_seperator (l)) + { + /* OK */ + } + else + { + WARN_SYNTAX_ERROR; + goto EXIT; + } + return file_write_matrix (l, My->CurrentFile->delimit); +EXIT: + RELEASE_VARIANT (X); + return (l); +} + +static LineType * +bwb_mat_dump (LineType * l, int IsWrite) +{ + /* MAT PRINT [ # filenumber , ] matrix [;|,] ... */ + /* MAT WRITE [ # filenumber , ] matrix [;|,] ... */ + /* Array must be 1, 2 or 3 dimensions */ + /* Array may be either NUMBER or STRING */ + char delimit; + + assert (l != NULL); + assert( My != NULL ); + assert( My->SYSOUT != NULL ); + + My->CurrentFile = My->SYSOUT; + if (line_skip_FilenumChar (l)) + { + /* ... # file, ... */ + if (parse_file_number (l) == FALSE) + { + return (l); + } + if (line_is_eol (l)) + { + WARN_SYNTAX_ERROR; + return (l); + } + } + + if (IsWrite) + { + /* MAT WRITE */ + delimit = My->CurrentFile->delimit; + } + else + { + /* MAT PRINT */ + delimit = ZoneChar; + } + return file_write_matrix (l, delimit); +} + +extern LineType * +bwb_MAT_WRITE (LineType * l) +{ + + assert (l != NULL); + + return bwb_mat_dump (l, TRUE); +} + +extern LineType * +bwb_MAT_PRINT (LineType * l) +{ + + assert (l != NULL); + + return bwb_mat_dump (l, FALSE); +} + + + +/* EOF */ |