--- /dev/null
+!% -GS\r
+!% $MAX_STATIC_DATA=20000;\r
+!%\r
+! =================================================================================================\r
+! INSTRUCTOR -- reformat Inform source files -- Roger Firth (roger@firthworks.com)\r
+!\r
+! V1.2 11Oct04 - fixed support for dynamic Class declarations\r
+! V1.1 29Jan04 - changed ReadSourceLine() to handle cross-platform End-Of-Line characters\r
+! V1.0 13Nov03 - first public release\r
+!\r
+! This program is a pretty-printer -- it reads an Inform source file, and writes the same\r
+! information, neatly formatted, to an output file (which must be DIFFERENT FROM the input file).\r
+! Use it only on source files which compile without any errors.\r
+!\r
+! The program is a standalone Glulx utility which does not used the Inform library files.\r
+! To compile it, you will need to include on the command line: $MAX_STATIC_DATA=20000\r
+! and you will require the "infglk.h" header file. To run it, any Glulx interpreter should do.\r
+!\r
+! This program is copyright Roger Firth 2003-2004. Copying and distribution, with or without \r
+! modification, are permitted in any medium without royalty provided the copyright notice and \r
+! this notice are preserved.\r
+!\r
+! =================================================================================================\r
+! These settings should be sufficient, but may need adjusting for an enormous game.\r
+\r
+Constant MAX_SOURCE 4100; ! Line of source input.\r
+Array theSource -> MAX_SOURCE;\r
+\r
+Constant MAX_STRING 4100; ! Double-quoted string.\r
+Array theString -> MAX_STRING;\r
+\r
+Constant MAX_OUTPUT 200; ! Line of source output.\r
+Array theOutput -> MAX_OUTPUT;\r
+\r
+Constant MAX_INPUT 50; ! Line of keyboard input.\r
+Array theInput -> MAX_INPUT;\r
+\r
+Constant MAX_TOKENS 2; ! Input tokens.\r
+Array TokenStart -> MAX_TOKENS;\r
+Array TokenEnd -> MAX_TOKENS;\r
+Array Tokens --> MAX_TOKENS; ! Command, optional numbers.\r
+\r
+\r
+Constant DEFAULT_INDENT 4; ! Tab size.\r
+Constant DEFAULT_COMMENT 40; ! Comment alignment;\r
+Constant DEFAULT_MARGIN 80; ! Wrap long lines.\r
+\r
+Constant fixBadSyntax = true; ! " to ' in name properties, etc.\r
+!Constant indentWithTabs = false; ! Leading spaces become tabs.\r
+\r
+! =================================================================================================\r
+! Since we're not using the Glulx Inform library files, we need to set up our own Glk\r
+! Input/Output.\r
+\r
+Include "infglk"; ! Use sensible names for calls to Glk.\r
+\r
+Array gg_event --> 4; ! The event handler uses a four-word array.\r
+Global gg_mainwin = 0; ! There is only one window.\r
+\r
+Constant ANY_OLD_ROCK 0; ! Rock values don't seem necessary here.\r
+\r
+! =================================================================================================\r
+! General constants used by the tool.\r
+\r
+Constant TAB $09;\r
+Constant NEWLINE $0A;\r
+Constant RETURN $0D;\r
+Constant SPACE $20;\r
+Constant SQUOTE $27;\r
+Constant COMMA $2C;\r
+Constant ATSIGN $40;\r
+\r
+Constant LEX_INVALID 0;\r
+Constant LEX_NEWLINE 100;\r
+Constant LEX_COMMENT 200;\r
+\r
+Constant LEX_VALUE 300; ! context-sensitive spacing\r
+Constant LEX_IDENT 310; ! ABC123_\r
+Constant LEX_STATEMENT 320; ! do if else objectloop print print_ret switch until while\r
+Constant LEX_NUMBER 370; ! 123 $FF $$1010\r
+Constant LEX_DQ_STRING 380; ! "..."\r
+Constant LEX_SQ_STRING 390; ! '...'\r
+Constant LEX_VALUE_END 399;\r
+\r
+Constant LEX_SEPARATE 400;\r
+\r
+Constant LEX_SEPG0 400; ! space before:NO after:NO\r
+Constant LEX_ARROW 410; ! ->\r
+Constant LEX_DOT 420; ! .\r
+Constant LEX_SEPG0_END 499; ! --> >> .# .& .. ..# ..& ::\r
+\r
+Constant LEX_SEPG1 500; ! space before:NO after:YES\r
+Constant LEX_COLON 510; ! :\r
+Constant LEX_SEMIC 520; ! ;\r
+Constant LEX_COMMA 530; ! ,\r
+Constant LEX_RPAREN 540; ! )\r
+Constant LEX_RBRACE 550; ! }\r
+Constant LEX_RBRCKT 560; ! ]\r
+Constant LEX_SEPG1_END 599; !\r
+\r
+Constant LEX_SEPG2 600; ! space before:YES after:NO\r
+Constant LEX_LPAREN 610; ! (\r
+Constant LEX_LBRACE 620; ! {\r
+Constant LEX_LTLT 630; ! <<\r
+Constant LEX_HASH 640; ! #\r
+Constant LEX_TILDE 650; ! ~\r
+Constant LEX_SEPG2_END 699; ! ~~ ## #a$ #n$ #r$ #w$ @ ? ?~\r
+\r
+Constant LEX_SEPG3 700; ! space before:YES after:YES\r
+Constant LEX_LBRCKT 710; ! [\r
+Constant LEX_ASTERISK 720; ! *\r
+Constant LEX_SEPG3_END 799; ! = + / % | || & && == ~= < > <= >=\r
+\r
+Constant LEX_SEPG4 800; ! context-sensitive spacing\r
+Constant LEX_MINUS 810; ! -\r
+Constant LEX_MINUSMINUS 820; ! --\r
+Constant LEX_PLUSPLUS 830; ! ++\r
+Constant LEX_SEPG4_END 899; !\r
+\r
+Constant LEX_SEPARATE_END 999;\r
+\r
+\r
+Array DirEnd string "End";\r
+Array DirIf3 string "Ifv3";\r
+Array DirIf5 string "Ifv5";\r
+Array DirLnk string "Link";\r
+Array DirStb string "Stub";\r
+Array DirVrb string "Verb";\r
+Array DirArr string "Array";\r
+Array DirCla string "Class";\r
+\r
+Array DirEnf string "Endif";\r
+Array DirIfd string "Ifdef";\r
+Array DirIfn string "Ifnot";\r
+Array DirTra string "Trace";\r
+Array DirUnd string "Undef";\r
+Array DirExt string "Extend";\r
+Array DirGlo string "Global";\r
+Array DirIfu string "Ifndef";\r
+\r
+Array DirIft string "Iftrue";\r
+Array DirImp string "Import";\r
+Array DirNby string "Nearby";\r
+Array DirObj string "Object";\r
+Array DirSer string "Serial";\r
+Array DirDef string "Default";\r
+Array DirIff string "Iffalse";\r
+Array DirInc string "Include";\r
+\r
+Array DirMsg string "Message";\r
+Array DirRel string "Release";\r
+Array DirRep string "Replace";\r
+Array DirVer string "Version";\r
+Array DirCon string "Constant";\r
+Array DirPro string "Property";\r
+Array DirSwi string "Switches";\r
+Array DirAtt string "Attribute";\r
+\r
+Array DirLow string "Lowstring";\r
+Array DirAbb string "Abbreviate";\r
+Array DirDct string "Dictionary";\r
+Array DirSts string "Statusline";\r
+Array DirZch string "Zcharacter";\r
+Array DirFak string "Fake_action";\r
+Array DirSys string "System_file";\r
+\r
+Array Directives table\r
+ DirEnd DirIf3 DirIf5 DirLnk DirStb DirVrb DirArr DirCla\r
+ DirEnf DirIfd DirIfn DirTra DirUnd DirExt DirGlo DirIfu\r
+ DirIft DirImp DirNby DirObj DirSer DirDef DirIff DirInc\r
+ DirMsg DirRel DirRep DirVer DirCon DirPro DirSwi DirAtt\r
+ DirLow DirAbb DirDct DirSts DirZch DirFak DirSys;\r
+\r
+\r
+Array ObjHas string "has";\r
+Array ObjWth string "with";\r
+Array ObjCla string "class";\r
+Array ObjPri string "private";\r
+\r
+Array ObjSegments table\r
+ ObjHas ObjWth ObjCla ObjPri;\r
+\r
+\r
+Array SmtDo_ string "do";\r
+Array SmtIf_ string "if";\r
+!Array SmtBox string "box";\r
+Array SmtFor string "for";\r
+Array SmtEls string "else";\r
+!Array SmtFnt string "font";\r
+!Array SmtGiv string "give";\r
+!Array SmtJmp string "jump";\r
+\r
+!Array SmtMov string "move";\r
+!Array SmtQit string "quit";\r
+!Array SmtRed string "read";\r
+!Array SmtSav string "save";\r
+!Array SmtBrk string "break";\r
+Array SmtPri string "print";\r
+!Array SmtRtr string "rtrue";\r
+!Array SmtSty string "style";\r
+\r
+Array SmtUnt string "until";\r
+Array SmtWhi string "while";\r
+!Array SmtRem string "remove";\r
+!Array SmtRet string "return";\r
+!Array SmtRfa string "rfalse";\r
+!Array SmtSpa string "spaces";\r
+!Array SmtStr string "string";\r
+Array SmtSwi string "switch";\r
+\r
+!Array SmtRes string "restore";\r
+!Array SmtNew string "new_line";\r
+!Array SmtCon string "continue";\r
+!Array SmtInv string "inversion";\r
+Array SmtPrt string "print_ret";\r
+Array SmtObj string "objectloop";\r
+\r
+! Array Statements table\r
+! SmtDo_ SmtIf_ SmtBox SmtFor SmtEls SmtFnt SmtGiv SmtJmp\r
+! SmtMov SmtQit SmtRed SmtSav SmtBrk SmtPri SmtRtr SmtSty\r
+! SmtUnt SmtWhi SmtRem SmtRet SmtRfa SmtSpa SmtStr SmtSwi\r
+! SmtRes SmtNew SmtCon SmtInv SmtPrt SmtObj;\r
+\r
+Array Statements table\r
+ SmtDo_ SmtIf_ SmtFor SmtEls SmtPri SmtUnt SmtWhi SmtSwi SmtPrt SmtObj;\r
+\r
+\r
+Array PrpNam string "name";\r
+\r
+Array Properties table\r
+ PrpNam PrpNam;\r
+\r
+! =================================================================================================\r
+! Variables used by the tool.\r
+\r
+Global indentSize = DEFAULT_INDENT;\r
+Global commentColumn = DEFAULT_COMMENT;\r
+Global marginColumn = DEFAULT_MARGIN;\r
+\r
+Global sourceStream;\r
+Global targetStream;\r
+\r
+Global currentState;\r
+Constant STATE_NONE 0;\r
+Constant STATE_CLASS_HEADER 100;\r
+Constant STATE_OBJECT_HEADER 200;\r
+Constant STATE_OBJECT_BODY 250;\r
+Constant STATE_VERB 300;\r
+Constant STATE_ROUTINE 400;\r
+Constant STATE_OTHER_DIR 500;\r
+\r
+Global nextWhite;\r
+Constant NEXT_NONE 0;\r
+Constant NEXT_SPACE 1;\r
+Constant NEXT_NEWLINE 2;\r
+Constant NEXT_BLANKLINE 3;\r
+\r
+Global savedChar; ! read one character too many\r
+Global sourceLine; ! source line count\r
+Global sourceLen; ! source line length\r
+Global sourceP1; ! start of lexeme\r
+Global sourceP2; ! end of lexeme + 1\r
+Global sourceP3; ! end of string + 1\r
+Global previousLex; ! previous lexeme\r
+Global parenCount; ! unmatched parentheses\r
+\r
+Global outputLen; ! output line length\r
+Global currentIndent; ! units of indentation\r
+\r
+Global prevLineBlank; ! a few flags\r
+Global routineIsEmbedded;\r
+Global directiveIsEmbedded;\r
+Global mapDQtoSQ;\r
+\r
+\r
+! =================================================================================================\r
+! Instructions for use.\r
+\r
+[ ShowHelp;\r
+ font off;\r
+ print "This tool pretty-prints an Inform source file. It is driven by these commands:^\r
+ ^\r
+ N - reformat a new source file. You are prompted for the name of the input\r
+ ^ source file, and for a second file to receive the output. Ensure that\r
+ ^ the output file is DIFFERENT FROM the input file, or the input will be\r
+ ^ overwritten.^\r
+ ^\r
+ Q - quit.^\r
+ ^\r
+ I <num> - specify the size of each indentation.^\r
+ I - reset to default of ", DEFAULT_INDENT, ".^\r
+ C <num> - specify the column to align inline comment (0 for no alignment).^\r
+ C - reset to default of ", DEFAULT_COMMENT, ".^\r
+ M <num> - specify the column to wrap long lines (0 for no wrap).^\r
+ M - reset to default of ", DEFAULT_MARGIN, ".^\r
+ ^\r
+ ? - display these instructions.^";\r
+ font on;\r
+];\r
+\r
+[ ShowStatus;\r
+ font off;\r
+ new_line;\r
+ print\r
+ " Indent:", indentSize,\r
+ " Inline comment col:", commentColumn,\r
+ " Right margin col:", marginColumn;\r
+ new_line; new_line;\r
+ font on;\r
+];\r
+\r
+! =================================================================================================\r
+! This is the top-level control loop.\r
+\r
+[ Main;\r
+\r
+ @setiosys 2 0; ! Set Glk as the VM's I/O layer.\r
+ gg_mainwin = ! Open the main window.\r
+ glk_window_open(0, 0, 0, wintype_TextBuffer, ANY_OLD_ROCK);\r
+ glk_set_window(gg_mainwin); ! Make it the current window.\r
+\r
+ glk_set_style(style_Header);\r
+ print "INSTRUCTOR 1.2";\r
+ glk_set_style(style_Normal);\r
+ print "^A tool for reformatting Inform source files.^^";\r
+ ShowHelp(); ! Explain what they can do.\r
+\r
+ while (true) { ! Loop here until "Q" typed.\r
+ ShowStatus();\r
+ print "> "; ! Prompt for a line of input.\r
+ if (~~ParseLine()) continue; ! Nothing typed\r
+ Tokens-->0 = theInput->(TokenStart->0);\r
+ Tokens-->1 = ParseNumber(TokenStart->1, TokenEnd->1);\r
+ switch (Tokens-->0) { ! Deal with the character, then loop back.\r
+ 'C','c': DoCommentColumn();\r
+ 'I','i': DoIndentSize();\r
+ 'M','m': DoMarginColumn();\r
+ 'N','n': DoReformat();\r
+ 'Q','q': DoQuit();\r
+ '?','/': ShowHelp();\r
+ default: print "Possible keys are N, Q, I, C, M and ?^";\r
+ }\r
+ }\r
+];\r
+\r
+! =================================================================================================\r
+! I/O handling.\r
+\r
+[ InputLine buf buflen; ! Input a line of characters.\r
+ glk_request_line_event(gg_mainwin, buf, buflen, 0);\r
+ while (true) { ! Wait for RETURN to be pressed.\r
+ glk_select(gg_event); ! LineInput is the only interesting event.\r
+ if (gg_event-->0 == evtype_LineInput && gg_event-->1 == gg_mainwin)\r
+ return (gg_event-->2); ! Number of characters.\r
+ }\r
+];\r
+\r
+[ ParseLine ! Read line of input, find tokens\r
+ i j n;\r
+ for (i=0 : i<MAX_TOKENS : i++) TokenStart->i = TokenEnd->i = 0;\r
+ n = InputLine(theInput, MAX_INPUT);\r
+ glk_select_poll(gg_event);\r
+ if (n == 0) rfalse; ! Nothing typed.\r
+ for (i=j=0 : i<MAX_TOKENS : i++) {\r
+ while (theInput->j == SPACE or COMMA) {\r
+ j++;\r
+ if (j >= n) return i;\r
+ }\r
+ TokenStart->i = j;\r
+ while (theInput->j ~= SPACE or COMMA) {\r
+ j++;\r
+ TokenEnd->i = j;\r
+ if (j >= n) return i+1;\r
+ }\r
+ }\r
+ return i;\r
+];\r
+\r
+[ ParseNumber a b ! Parse token as bin/dec/hex number.\r
+ char base num i;\r
+ if (a == b) return -1;\r
+ base = 10; num = 0;\r
+ i = a;\r
+ if (theInput->i == '-') i++;\r
+ if (theInput->i == '$') {\r
+ base = 16; i++;\r
+ if (theInput->i == '$') { base = 2; i++; }\r
+ }\r
+ for ( : i<b : i++) {\r
+ char = theInput->i;\r
+ if (char >= '0' && char <= '9') char = char - '0';\r
+ else {\r
+ if (char >= 'A' && char <= 'Z') char = char - 'A' + 10;\r
+ else {\r
+ if (char >= 'a' && char <= 'z') char = char - 'a' + 10;\r
+ else return -1;\r
+ }\r
+ }\r
+ if (char < base) num = (num * base) + char;\r
+ else return -1;\r
+ }\r
+ if (theInput->a == '-') num = -num;\r
+ return num;\r
+];\r
+\r
+[ OpenSourceForRead\r
+ fileref;\r
+ fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Read, ANY_OLD_ROCK);\r
+ if (fileref == GLK_NULL) "Failed to create Source fileref.";\r
+ sourceStream = glk_stream_open_file(fileref, filemode_Read, ANY_OLD_ROCK);\r
+ if (sourceStream == GLK_NULL) "Failed to open Source stream.";\r
+ glk_fileref_destroy(fileref);\r
+ rfalse; ! Successful -- OK to continue.\r
+];\r
+\r
+[ OpenTargetForWrite\r
+ fileref;\r
+ fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Write, ANY_OLD_ROCK);\r
+ if (fileref == GLK_NULL) "Failed to create Target fileref.";\r
+ targetStream = glk_stream_open_file(fileref, filemode_Write, ANY_OLD_ROCK);\r
+ if (targetStream == GLK_NULL) "Failed to open Target stream.";\r
+ glk_fileref_destroy(fileref);\r
+ rfalse; ! Successful -- OK to continue.\r
+];\r
+\r
+! =================================================================================================\r
+! Quit from the utility.\r
+\r
+[ DoQuit;\r
+ print "Hit any key to exit.^"; quit;\r
+];\r
+\r
+! =================================================================================================\r
+! Set indent size.\r
+\r
+[ DoIndentSize;\r
+ if (Tokens-->1 < 0)\r
+ indentSize = DEFAULT_INDENT;\r
+ else\r
+ indentSize = Tokens-->1;\r
+];\r
+\r
+! =================================================================================================\r
+! Set inline comment column.\r
+\r
+[ DoCommentColumn;\r
+ if (Tokens-->1 < 0)\r
+ commentColumn = DEFAULT_COMMENT;\r
+ else\r
+ commentColumn = Tokens-->1;\r
+];\r
+\r
+! =================================================================================================\r
+! Set right margin column.\r
+\r
+[ DoMarginColumn;\r
+ if (Tokens-->1 < 0)\r
+ marginColumn = DEFAULT_MARGIN;\r
+ else\r
+ marginColumn = Tokens-->1;\r
+];\r
+\r
+! =================================================================================================\r
+! Reformat the source.\r
+\r
+[ DoReformat\r
+ lex x;\r
+\r
+ print "First, specify an Inform source file to be reformatted.^";\r
+ glk_select_poll(gg_event);\r
+ if (OpenSourceForRead()) return;\r
+\r
+ print "Now, specify a DIFFERENT file to hold the reformatted output.^";\r
+ glk_select_poll(gg_event);\r
+ if (OpenTargetForWrite()) { glk_stream_close(sourceStream, GLK_NULL); return; }\r
+\r
+ currentState = STATE_NONE;\r
+ nextWhite = NEXT_NONE;\r
+ sourceLine = sourceLen = sourceP1 = sourceP2 = sourceP3 = 0;\r
+ previousLex = parenCount = outputLen = currentIndent = 0;\r
+\r
+ prevLineBlank = true;\r
+ routineIsEmbedded = directiveIsEmbedded = mapDQtoSQ = false;\r
+\r
+ ! Break the source file into lexemes.\r
+\r
+ for (lex=GetLexeme() : lex : lex=GetLexeme()) {\r
+\r
+ ! Deal with newlines and comments.\r
+\r
+ if (lex == LEX_NEWLINE) {\r
+ switch (nextWhite) {\r
+ NEXT_NEWLINE: PutNL(1);\r
+ NEXT_BLANKLINE: PutNL(2);\r
+ }\r
+ continue;\r
+ }\r
+ if (lex == LEX_COMMENT) {\r
+ if (outputLen) {\r
+ PutSpace(commentColumn-outputLen);\r
+ nextWhite = NEXT_SPACE;\r
+ }\r
+ else\r
+ nextWhite = NEXT_NONE;\r
+ PrintLexeme(lex); PutNL(1);\r
+ continue;\r
+ }\r
+ switch (nextWhite) {\r
+ NEXT_NEWLINE: PutNL(1);\r
+ NEXT_BLANKLINE: PutNL(2);\r
+ }\r
+\r
+ ! Set up default spacing for this lexeme.\r
+\r
+ switch (lex) {\r
+ LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG1 to LEX_SEPG1_END:\r
+ nextWhite = NEXT_NONE;\r
+ LEX_SEPG2 to LEX_SEPG2_END, LEX_SEPG3 to LEX_SEPG3_END:\r
+ nextWhite = NEXT_SPACE;\r
+ }\r
+\r
+ ! Handle the lexeme according to the current major state.\r
+\r
+ switch (currentState) {\r
+\r
+ ! At outermost level of source.\r
+\r
+ STATE_NONE:\r
+ print "* "; glk_select_poll(gg_event);\r
+ currentIndent = 0;\r
+ switch (lex) {\r
+ LEX_IDENT: ! New directive.\r
+ x = MatchString(theSource, sourceP1, sourceP2, Directives);\r
+ if (x) switch (Directives-->x) {\r
+ DirCla:\r
+ nextWhite = NEXT_BLANKLINE;\r
+ currentState = STATE_CLASS_HEADER;\r
+ DirObj,DirNby:\r
+ nextWhite = NEXT_BLANKLINE;\r
+ currentState = STATE_OBJECT_HEADER;\r
+ DirVrb,DirExt:\r
+ nextWhite = NEXT_BLANKLINE;\r
+ currentState = STATE_VERB;\r
+ if (fixBadSyntax) mapDQtoSQ = true;\r
+ default:\r
+ currentState = STATE_OTHER_DIR;\r
+ }\r
+ else { ! Must be a user-defined class.\r
+ nextWhite = NEXT_BLANKLINE;\r
+ currentState = STATE_OBJECT_HEADER;\r
+ }\r
+ if (fixBadSyntax && Directives-->x == DirNby) {\r
+ PutChar('O'); PutChar('b'); PutChar('j'); PutChar('e'); PutChar('c'); PutChar('t');\r
+ PutChar(' '); PutChar(' '); PutChar('-'); PutChar('>');\r
+ nextWhite = NEXT_SPACE;\r
+ }\r
+ else {\r
+ PrintDirective();\r
+ if (currentState == STATE_CLASS_HEADER or STATE_OBJECT_HEADER)\r
+ PutSpace(indentSize*2-sourceP2+sourceP1);\r
+ }\r
+ LEX_LBRCKT: ! New standalone routine.\r
+ nextWhite = NEXT_BLANKLINE; PrintLexeme(lex);\r
+ currentIndent = 1; ControlReset();\r
+ currentState = STATE_ROUTINE; routineIsEmbedded = false;\r
+ LEX_HASH: ! Prefix to new directive.\r
+ PrintLexeme(lex);\r
+ default:\r
+ PrintLexeme(lex);\r
+ "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_NONE.";\r
+ }\r
+\r
+ ! Standalone or Embedded routine.\r
+\r
+ STATE_ROUTINE:\r
+ switch (ControlGet()) {\r
+ CONTROL_IF_SCOPE:\r
+ if (lex == LEX_LBRACE)\r
+ ControlSet(CONTROL_IF_MULTI);\r
+ else {\r
+ ControlSet(CONTROL_IF_SINGLE);\r
+ currentIndent++;\r
+ nextWhite = NEXT_NEWLINE;\r
+ }\r
+ CONTROL_XX_SCOPE:\r
+ if (lex == LEX_LBRACE)\r
+ ControlSet(CONTROL_XX_MULTI);\r
+ else {\r
+ ControlSet(CONTROL_XX_SINGLE);\r
+ currentIndent++;\r
+ nextWhite = NEXT_NEWLINE;\r
+ }\r
+ }\r
+ switch (lex) {\r
+ LEX_SEMIC:\r
+ PrintLexeme(lex);\r
+ if (previousLex == LEX_RBRCKT && ~~routineIsEmbedded) {\r
+ currentState = STATE_NONE;\r
+ nextWhite = NEXT_BLANKLINE;\r
+ }\r
+ while (ControlGet() == CONTROL_XX_SINGLE) {\r
+ ControlPop();\r
+ currentIndent--;\r
+ }\r
+ if (ControlGet() == CONTROL_IF_SINGLE) {\r
+ ControlSet(CONTROL_IF_ELSE);\r
+ currentIndent--;\r
+ }\r
+ LEX_RBRCKT:\r
+ if (routineIsEmbedded) {\r
+ currentState = STATE_OBJECT_BODY;\r
+ currentIndent = 2;\r
+ }\r
+ else\r
+ currentIndent = 0;\r
+ PrintLexeme(lex);\r
+ LEX_HASH:\r
+ if (outputLen == 0) { ! Prefix to new directive.\r
+ PrintLexeme(lex);\r
+ lex = GetLexeme();\r
+ PrintDirective();\r
+ currentState = STATE_OTHER_DIR; directiveIsEmbedded = true;\r
+ }\r
+ else\r
+ PrintLexeme(lex);\r
+ LEX_LBRACE:\r
+ PrintLexeme(lex);\r
+ currentIndent++;\r
+ LEX_RBRACE:\r
+ currentIndent--;\r
+ if (ControlGet() == CONTROL_IF_MULTI) {\r
+ ControlSet(CONTROL_IF_ELSE);\r
+ PrintLexeme(lex);\r
+ }\r
+ else {\r
+ if (ControlGet() == CONTROL_IF_ELSE) {\r
+ ControlPop();\r
+ while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {\r
+ ControlPop();\r
+ currentIndent--;\r
+ }\r
+ if (ControlGet() == CONTROL_IF_MULTI)\r
+ ControlSet(CONTROL_IF_ELSE);\r
+ }\r
+ PrintLexeme(lex);\r
+ if (ControlGet() == CONTROL_XX_MULTI) {\r
+ ControlPop();\r
+ while (ControlGet() == CONTROL_XX_SINGLE) {\r
+ ControlPop();\r
+ currentIndent--;\r
+ }\r
+ if (ControlGet() == CONTROL_IF_SINGLE) {\r
+ ControlSet(CONTROL_IF_ELSE);\r
+ currentIndent--;\r
+ }\r
+ }\r
+ }\r
+ LEX_COLON:\r
+ if (parenCount == 0) {\r
+ PullSpace(indentSize/2); PrintLexeme(lex); nextWhite = NEXT_NEWLINE;\r
+ } else {\r
+ nextWhite = NEXT_SPACE; PrintLexeme(lex);\r
+ }\r
+ LEX_DOT:\r
+ if (outputLen)\r
+ PrintLexeme(lex);\r
+ else\r
+ { nextWhite = NEXT_NEWLINE; PrintLexeme(lex); PullSpace(indentSize/2); }\r
+ LEX_LPAREN, LEX_PLUSPLUS, LEX_MINUSMINUS:\r
+ if (previousLex == LEX_IDENT or LEX_LPAREN or LEX_PLUSPLUS or LEX_MINUSMINUS)\r
+ nextWhite = NEXT_NONE;\r
+ PrintLexeme(lex);\r
+ LEX_RPAREN:\r
+ PrintLexeme(lex);\r
+ if (parenCount == 0) {\r
+ if (ControlGet() == CONTROL_IF_COND) ControlSet(CONTROL_IF_SCOPE);\r
+ if (ControlGet() == CONTROL_XX_COND) ControlSet(CONTROL_XX_SCOPE);\r
+ }\r
+ LEX_MINUS:\r
+ PrintLexeme(lex);\r
+ if (previousLex ~= LEX_IDENT or LEX_NUMBER or LEX_RPAREN)\r
+ nextWhite = NEXT_NONE;\r
+ LEX_IDENT:\r
+ x = MatchString(theSource, sourceP1, sourceP2, Statements);\r
+ if (ControlGet() == CONTROL_IF_ELSE && ~~(x && Statements-->x == SmtEls)) {\r
+ ControlPop();\r
+ while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {\r
+ ControlPop();\r
+ currentIndent--;\r
+ }\r
+ }\r
+ if (x) {\r
+ lex = LEX_STATEMENT;\r
+ switch (Statements-->x) {\r
+ SmtIf_:\r
+ ControlPush(CONTROL_IF_COND);\r
+ SmtFor, SmtWhi, SmtSwi, SmtObj:\r
+ ControlPush(CONTROL_XX_COND);\r
+ SmtDo_:\r
+ ControlPush(CONTROL_XX_SCOPE);\r
+ SmtEls:\r
+ ControlSet(CONTROL_XX_SCOPE);\r
+ }\r
+ }\r
+ if (previousLex == LEX_PLUSPLUS or LEX_MINUSMINUS)\r
+ nextWhite = NEXT_NONE;\r
+ PrintLexeme(lex);\r
+ LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
+ if (ControlGet() == CONTROL_IF_ELSE) {\r
+ ControlPop();\r
+ while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {\r
+ ControlPop();\r
+ currentIndent--;\r
+ }\r
+ }\r
+ PrintLexeme(lex);\r
+ default:\r
+ PrintLexeme(lex);\r
+ "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_ROUTINE.";\r
+ }\r
+\r
+ ! Class or Object directive, in header.\r
+\r
+ STATE_CLASS_HEADER,\r
+ STATE_OBJECT_HEADER:\r
+ switch (lex) {\r
+ LEX_SEMIC:\r
+ PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;\r
+ currentState = STATE_NONE;\r
+ LEX_IDENT:\r
+ if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) {\r
+ PutNL(1);\r
+ currentIndent = 2;\r
+ PrintLexeme(lex);\r
+ PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1);\r
+ currentState = STATE_OBJECT_BODY;\r
+ }\r
+ else {\r
+ if (currentState == STATE_CLASS_HEADER)\r
+ PrintDirective();\r
+ else\r
+ PrintLexeme(lex);\r
+ }\r
+ LEX_ARROW, LEX_DQ_STRING:\r
+ nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE;\r
+ LEX_LPAREN, LEX_NUMBER, LEX_RPAREN:\r
+ nextWhite = NEXT_NONE; PrintLexeme(lex);\r
+ LEX_COMMA: ! don't need a comma here\r
+ if (~~fixBadSyntax) PrintLexeme(lex);\r
+ default:\r
+ PrintLexeme(lex);\r
+ "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_CLASS/OBJECT_HEADER.";\r
+ }\r
+\r
+ ! Class or Object directive, in body.\r
+\r
+ STATE_OBJECT_BODY:\r
+ switch (lex) {\r
+ LEX_SEMIC:\r
+ PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;\r
+ currentState = STATE_NONE;\r
+ currentIndent = 0;\r
+ mapDQtoSQ = false;\r
+ LEX_LBRCKT: ! New embedded routine.\r
+ PrintLexeme(lex);\r
+ currentIndent++; ControlReset();\r
+ currentState = STATE_ROUTINE; routineIsEmbedded = true;\r
+ LEX_COMMA:\r
+ PrintLexeme(lex); nextWhite = NEXT_NEWLINE;\r
+ mapDQtoSQ = false;\r
+ LEX_IDENT:\r
+ if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) {\r
+ if (previousLex ~= LEX_COMMA) {\r
+ if (fixBadSyntax) PutChar(',');\r
+ PutNL(1);\r
+ }\r
+ PrintLexeme(lex);\r
+ PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1);\r
+ mapDQtoSQ = false;\r
+ }\r
+ else {\r
+ if (fixBadSyntax && MatchString(theSource, sourceP1, sourceP2, Properties)) mapDQtoSQ = true;\r
+ PrintLexeme(lex);\r
+ }\r
+ LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
+ PrintLexeme(lex);\r
+ default:\r
+ PrintLexeme(lex);\r
+ "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OBJECT_BODY.";\r
+ }\r
+\r
+ ! Verb directive.\r
+\r
+ STATE_VERB:\r
+ switch (lex) {\r
+ LEX_SEMIC:\r
+ PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;\r
+ currentState = STATE_NONE;\r
+ currentIndent = 0;\r
+ mapDQtoSQ = false;\r
+ LEX_ASTERISK:\r
+ currentIndent = 1;\r
+ nextWhite = NEXT_NEWLINE; PrintLexeme(lex);\r
+ LEX_ARROW:\r
+ nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE;\r
+ LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
+ PrintLexeme(lex);\r
+ default:\r
+ PrintLexeme(lex);\r
+ "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_VERB.";\r
+ }\r
+\r
+ ! Other directive (not Class/Object/Verb).\r
+\r
+ STATE_OTHER_DIR:\r
+ switch (lex) {\r
+ LEX_SEMIC:\r
+ PrintLexeme(lex);\r
+ if (directiveIsEmbedded) {\r
+ currentState = STATE_ROUTINE; directiveIsEmbedded = false;\r
+ }\r
+ else {\r
+ currentState = STATE_NONE;\r
+ currentIndent = 0;\r
+ }\r
+ LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:\r
+ PrintLexeme(lex);\r
+ default:\r
+ PrintLexeme(lex);\r
+ "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OTHER_DIR.";\r
+ }\r
+\r
+ } ! end of switch(currentState)\r
+ previousLex = lex;\r
+ }\r
+ if (outputlen) PutNL(1);\r
+\r
+ glk_stream_close(sourceStream, GLK_NULL);\r
+ glk_stream_close(targetStream, GLK_NULL);\r
+ "^^OK";\r
+];\r
+\r
+[ MatchString buf p1 p2 tab\r
+ i j k len str;\r
+ len = p2 - p1;\r
+ for (i=1 : i<=tab-->0 : i++) {\r
+ str = tab-->i;\r
+ if (str->0 < len) continue;\r
+ if (str->0 > len) rfalse;\r
+ for (j=1,k=p1 : j<=len : j++,k++)\r
+ if ((str->j | $20) ~= (buf->k | $20)) jump tryNext;\r
+ return i;\r
+ .tryNext;\r
+ }\r
+ rfalse;\r
+];\r
+\r
+! =================================================================================================\r
+! Stack for control structuress.\r
+\r
+Constant MAX_STACK 20; ! Nested control structures.\r
+Array controlStack --> MAX_STACK;\r
+\r
+Constant CONTROL_IF_COND 10; ! Looking for end of IF condition\r
+Constant CONTROL_IF_SCOPE 11; ! Looking for { after IF condition\r
+Constant CONTROL_IF_SINGLE 12; ! Controlling a single statement\r
+Constant CONTROL_IF_MULTI 13; ! Controlling multiple statements\r
+Constant CONTROL_IF_ELSE 14; ! Looking for ELSE after IF statement\r
+Constant CONTROL_XX_COND 20; ! Looking for end of other condition\r
+Constant CONTROL_XX_SCOPE 21; ! Looking for { after other condition\r
+Constant CONTROL_XX_SINGLE 22; ! Controlling a single statement\r
+Constant CONTROL_XX_MULTI 23; ! Controlling multiple statements\r
+\r
+[ ControlPush val\r
+ p;\r
+ p = (controlStack-->0) + 1;\r
+ if (p == MAX_STACK) {\r
+ print "Stack overflow: increase MAX_STACK and recompile.^";\r
+ DoQuit();\r
+ }\r
+ controlStack-->0 = p;\r
+ controlStack-->p = val;\r
+];\r
+\r
+[ ControlPop\r
+ p;\r
+ p = controlStack-->0;\r
+ if (p) {\r
+ (controlStack-->0)--;\r
+ p = controlStack-->p;\r
+ }\r
+ return p;\r
+];\r
+\r
+[ ControlSet val\r
+ p;\r
+ p = controlStack-->0;\r
+ if (p)\r
+ controlStack-->p = val;\r
+ else\r
+ "INSPECTOR bug at source line ", sourceLine, ": StackSet on empty stack.";\r
+];\r
+\r
+[ ControlGet\r
+ p;\r
+ p = controlStack-->0;\r
+ if (p)\r
+ p = controlStack-->p;\r
+ return p;\r
+];\r
+\r
+[ ControlReset; controlStack-->0 = 0; ];\r
+\r
+! [ ControlDebug x\r
+! i;\r
+! new_line;\r
+! switch (x) {\r
+! 0: print "Xxx ";\r
+! 1: print "Psh ";\r
+! 2: print "Pop ";\r
+! 3: print "Set ";\r
+! 4: print "Get ";\r
+! default: print x, " ";\r
+! }\r
+! for (i=1 : i<=controlStack-->0 : i++) {\r
+! print i,":";\r
+! switch (controlStack-->i) {\r
+! 0: print "none ";\r
+! CONTROL_IF_COND: print "IfCo ";\r
+! CONTROL_IF_SCOPE: print "IfSc ";\r
+! CONTROL_IF_SINGLE:print "IfSi ";\r
+! CONTROL_IF_MULTI: print "IfMu ";\r
+! CONTROL_IF_ELSE: print "IfEl ";\r
+! CONTROL_XX_COND: print "XxCo ";\r
+! CONTROL_XX_SCOPE: print "XxSc ";\r
+! CONTROL_XX_SINGLE:print "XxSi ";\r
+! CONTROL_XX_MULTI: print "XxMu ";\r
+! }\r
+! }\r
+! new_line;\r
+! ];\r
+\r
+! =================================================================================================\r
+\r
+[ GetLexeme\r
+ c rval;\r
+\r
+ if (sourceLen == 0) { ! Need next line of source.\r
+ sourceLen = ReadSourceLine();\r
+ if (sourceLen == 0) rfalse; ! End-of-file.\r
+ sourceP1 = 0; ! Start of buffer.\r
+ }\r
+ else\r
+ sourceP1 = sourceP2; ! Continue from last time.\r
+\r
+ ! Ignore leading whitespace.\r
+\r
+ while (isWhiteSpace(theSource->sourceP1)) sourceP1++;\r
+ if (theSource->sourceP1 == NEWLINE) {\r
+ sourceLen = 0;\r
+ return LEX_NEWLINE;\r
+ }\r
+\r
+ ! Found start of lexeme.\r
+\r
+ sourceP2 = sourceP1 + 1;\r
+ switch (theSource->sourceP1) {\r
+\r
+ '_', 'A' to 'Z', 'a' to 'z': ! identifier\r
+ while (isIdentifier(theSource->sourceP2)) sourceP2++;\r
+ rval = LEX_IDENT;\r
+\r
+ '0' to '9': ! decimal number\r
+ while (isDecimal(theSource->sourceP2)) sourceP2++;\r
+ rval = LEX_NUMBER;\r
+\r
+ '$': ! hex/binary number\r
+ if (theSource->sourceP2 == '$') {\r
+ sourceP2++;\r
+ while(isBinary(theSource->sourceP2)) sourceP2++;\r
+ }\r
+ else {\r
+ while(isHex(theSource->sourceP2)) sourceP2++;\r
+ }\r
+ rval = LEX_NUMBER;\r
+\r
+ '"': ! "..." string\r
+ theString->0 = theSource->sourceP1;\r
+ sourceP3 = 1;\r
+ do {\r
+ if (sourceP3 == MAX_STRING) {\r
+ print "String too long: increase MAX_STRING and recompile.^";\r
+ DoQuit();\r
+ }\r
+ c = theSource->(sourceP2++); theString->(sourceP3++) = c;\r
+ if (c == NEWLINE) {\r
+ do {\r
+ sourceLen = ReadSourceLine();\r
+ sourceP2 = 0;\r
+ while (isWhiteSpace(theSource->sourceP2)) sourceP2++;\r
+ } until (theSource->sourceP2 ~= NEWLINE);\r
+ }\r
+ } until (c == '"');\r
+ rval = LEX_DQ_STRING;\r
+\r
+ SQUOTE: ! '...' string\r
+ while (theSource->sourceP2 ~= SQUOTE) sourceP2++;\r
+ sourceP2++;\r
+ rval = LEX_SQ_STRING;\r
+\r
+ '!': ! comment\r
+ sourceP2 = sourceLen - 1;\r
+ rval = LEX_COMMENT;\r
+\r
+ '#':\r
+ switch (theSource->sourceP2) {\r
+ '#': sourceP2++; rval = LEX_SEPG2_END; ! ##\r
+ 'a':\r
+ switch (theSource->(sourceP2+1)) {\r
+ '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #a$\r
+ default: rval = LEX_HASH; ! #\r
+ }\r
+ 'n':\r
+ switch (theSource->(sourceP2+1)) {\r
+ '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #n$\r
+ default: rval = LEX_HASH; ! #\r
+ }\r
+ 'r':\r
+ switch (theSource->(sourceP2+1)) {\r
+ '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #r$\r
+ default: rval = LEX_HASH; ! #\r
+ }\r
+ 'w':\r
+ switch (theSource->(sourceP2+1)) {\r
+ '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #w$\r
+ default: rval = LEX_HASH; ! #\r
+ }\r
+ default: rval = LEX_HASH; ! #\r
+ }\r
+\r
+ '%': rval = LEX_SEPG3_END; ! %\r
+\r
+ '&':\r
+ switch (theSource->sourceP2) {\r
+ '&': sourceP2++; rval = LEX_SEPG3_END; ! &&\r
+ default: rval = LEX_SEPG3_END; ! &\r
+ }\r
+\r
+ '(': rval = LEX_LPAREN; ! (\r
+ parenCount++;\r
+\r
+ ')': rval = LEX_RPAREN; ! )\r
+ parenCount--;\r
+\r
+ '*': rval = LEX_ASTERISK; ! *\r
+\r
+ '+':\r
+ switch (theSource->sourceP2) {\r
+ '+': sourceP2++; rval = LEX_PLUSPLUS; ! ++\r
+ default: rval = LEX_SEPG3_END; ! +\r
+ }\r
+\r
+ ',': rval = LEX_COMMA; ! ,\r
+\r
+ '-':\r
+ switch (theSource->sourceP2) {\r
+ '-':\r
+ sourceP2++; switch (theSource->sourceP2) {\r
+ '>': sourceP2++; rval = LEX_SEPG0_END; ! -->\r
+ default: rval = LEX_MINUSMINUS; ! --\r
+ }\r
+ '>': sourceP2++; rval = LEX_ARROW; ! ->\r
+ default: rval = LEX_MINUS; ! -\r
+ }\r
+\r
+ '.':\r
+ switch (theSource->sourceP2) {\r
+ '.':\r
+ sourceP2++; switch (theSource->sourceP2) {\r
+ '#': sourceP2++; rval = LEX_SEPG0_END; ! ..#\r
+ '&': sourceP2++; rval = LEX_SEPG0_END; ! ..&\r
+ default: rval = LEX_SEPG0_END; ! ..\r
+ }\r
+ '#': sourceP2++; rval = LEX_SEPG0_END; ! .#\r
+ '&': sourceP2++; rval = LEX_SEPG0_END; ! .&\r
+ default: rval = LEX_DOT; ! .\r
+ }\r
+\r
+ '/': rval = LEX_SEPG3_END; ! /\r
+\r
+ ':':\r
+ switch (theSource->sourceP2) {\r
+ ':': sourceP2++; rval = LEX_SEPG0_END; ! ::\r
+ default: rval = LEX_COLON; ! :\r
+ }\r
+\r
+ ';': rval = LEX_SEMIC; ! ;\r
+\r
+ '<':\r
+ switch (theSource->sourceP2) {\r
+ '=': sourceP2++; rval = LEX_SEPG3_END; ! <=\r
+ '<': sourceP2++; rval = LEX_LTLT; ! <<\r
+ default: rval = LEX_SEPG3_END; ! <\r
+ }\r
+\r
+ '=':\r
+ switch (theSource->sourceP2) {\r
+ '=': sourceP2++; rval = LEX_SEPG3_END; ! ==\r
+ default: rval = LEX_SEPG3_END; ! =\r
+ }\r
+\r
+ '>':\r
+ switch (theSource->sourceP2) {\r
+ '=': sourceP2++; rval = LEX_SEPG3_END; ! >=\r
+ '>': sourceP2++; rval = LEX_SEPG0_END; ! >>\r
+ default: rval = LEX_SEPG3_END; ! >\r
+ }\r
+\r
+ '?':\r
+ switch (theSource->sourceP2) {\r
+ '~': sourceP2++; rval = LEX_SEPG2_END; ! ?~\r
+ default: rval = LEX_SEPG2_END; ! ?\r
+ }\r
+\r
+ ATSIGN: rval = LEX_SEPG2_END; ! @\r
+\r
+ '[': rval = LEX_LBRCKT; ! [\r
+\r
+ ']': rval = LEX_RBRCKT; ! ]\r
+\r
+ '{': rval = LEX_LBRACE; ! {\r
+\r
+ '}': rval = LEX_RBRACE; ! }\r
+\r
+ '|':\r
+ switch (theSource->sourceP2) {\r
+ '|': sourceP2++; rval = LEX_SEPG3_END; ! ||\r
+ default: rval = LEX_SEPG3_END; ! |\r
+ }\r
+\r
+ '~':\r
+ switch (theSource->sourceP2) {\r
+ '=': sourceP2++; rval = LEX_SEPG3_END; ! ~=\r
+ '~': sourceP2++; rval = LEX_SEPG2_END; ! ~~\r
+ default: rval = LEX_TILDE; ! ~\r
+ }\r
+\r
+ default: rval = LEX_INVALID; ! Not valid.\r
+ }\r
+ return rval;\r
+];\r
+\r
+[ isWhiteSpace c;\r
+ if (c == ' ' or TAB) rtrue;\r
+ rfalse;\r
+];\r
+\r
+[ isBinary c;\r
+ if (c == '0' or '1') rtrue;\r
+ rfalse;\r
+];\r
+\r
+[ isDecimal c;\r
+ if (c >= '0' && c <= '9') rtrue;\r
+ rfalse;\r
+];\r
+\r
+[ isHex c;\r
+ if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'F') || (c >= 'a' && c <= 'f')) rtrue;\r
+ rfalse;\r
+];\r
+\r
+[ isIdentifier c;\r
+ if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c == '_')) rtrue;\r
+ rfalse;\r
+];\r
+\r
+[ ReadSourceChar\r
+ c;\r
+ if (savedChar) { c = savedChar; savedChar = 0; }\r
+ else c = glk_get_char_stream(sourceStream);\r
+ if (c == NEWLINE or RETURN) {\r
+ savedChar = glk_get_char_stream(sourceStream);\r
+ if (savedChar == NEWLINE or RETURN && savedChar ~= c) savedChar = 0;\r
+ c = NEWLINE;\r
+ }\r
+ return c;\r
+];\r
+\r
+[ ReadSourceLine\r
+ c len;\r
+ do {\r
+ c = ReadSourceChar();\r
+ if (c == -1) ! end of stream\r
+ if (len) c = NEWLINE; else return 0;\r
+ if (len == MAX_SOURCE) {\r
+ print "Source line too long: increase MAX_SOURCE and recompile.^";\r
+ DoQuit();\r
+ break;\r
+ }\r
+ theSource->len++ = c;\r
+ } until (c == NEWLINE);\r
+ sourceLine++;\r
+ return len;\r
+];\r
+\r
+! [ ReadSourceLine\r
+! len;\r
+! len = glk_get_line_stream(sourceStream, theSource, MAX_SOURCE);\r
+! sourceLine++;\r
+! if (len && theSource->(len-1) ~= NEWLINE)\r
+! if (len == MAX_SOURCE-1) {\r
+! print "Source line too long: increase MAX_SOURCE and recompile.^";\r
+! DoQuit();\r
+! }\r
+! else\r
+! theSource->(len++) = NEWLINE;\r
+! return len;\r
+! ];\r
+\r
+! =================================================================================================\r
+\r
+[ PrintDirective\r
+ i;\r
+ switch (nextWhite) {\r
+ NEXT_NONE:\r
+ ;\r
+ NEXT_SPACE:\r
+ if (marginColumn > 0 && outputLen > marginColumn)\r
+ PutNL(1);\r
+ else\r
+ PutSpace(1);\r
+ NEXT_NEWLINE:\r
+ PutNL(1);\r
+ NEXT_BLANKLINE:\r
+ PutNL(2);\r
+ }\r
+ i = sourceP1;\r
+ PutUpper(theSource->i);\r
+ for (i++ : i<sourceP2 : i++) PutLower(theSource->i);\r
+ nextWhite = NEXT_SPACE;\r
+];\r
+\r
+[ PrintLexeme lex\r
+ i;\r
+ switch (nextWhite) {\r
+ NEXT_NONE:\r
+ ;\r
+ NEXT_SPACE:\r
+ if (marginColumn > 0 && outputLen > marginColumn && lex ~= LEX_COMMENT)\r
+ PutNL(1);\r
+ else\r
+ PutSpace(1);\r
+ NEXT_NEWLINE:\r
+ PutNL(1);\r
+ NEXT_BLANKLINE:\r
+ PutNL(2);\r
+ }\r
+\r
+ if (lex == LEX_DQ_STRING) {\r
+ if (outputLen)\r
+ for (i=0 : i<sourceP3 : i++)\r
+ if (theString->i == NEWLINE) {\r
+ currentIndent++;\r
+ PutNL(1);\r
+ for (i=0 : i<sourceP3 : i++) PutChar(theString->i);\r
+ currentIndent--;\r
+ jump Done;\r
+ }\r
+ if (mapDQtoSQ) {\r
+! theString->0 = theString->(sourceP3-1) = SQUOTE; ! avoid compiler bug\r
+ theString->0 = SQUOTE;\r
+ theString->(sourceP3-1) = SQUOTE;\r
+ }\r
+ for (i=0 : i<sourceP3 : i++) PutChar(theString->i);\r
+ }\r
+ else\r
+ for (i=sourceP1 : i<sourceP2 : i++)\r
+ if (theSource->i == TAB)\r
+ PutChar(SPACE);\r
+ else\r
+ PutChar(theSource->i);\r
+\r
+ .Done;\r
+\r
+ switch (lex) {\r
+ LEX_SEMIC, LEX_LBRACE, LEX_RBRACE:\r
+ nextWhite = NEXT_NEWLINE;\r
+ LEX_VALUE to LEX_VALUE_END, LEX_SEPG4 to LEX_SEPG4_END,\r
+ LEX_SEPG1 to LEX_SEPG1_END, LEX_SEPG3 to LEX_SEPG3_END:\r
+ nextWhite = NEXT_SPACE;\r
+ LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG2 to LEX_SEPG2_END:\r
+ nextWhite = NEXT_NONE;\r
+ }\r
+];\r
+\r
+[ PutChar c;\r
+ if (c == NEWLINE) return PutNL(1);\r
+ if (outputLen == 0) {\r
+ for ( : outputLen<indentSize*currentIndent : outputLen++) theOutput->outputLen = SPACE;\r
+ if (c == SPACE) return;\r
+ }\r
+ if (outputLen == MAX_OUTPUT) {\r
+ print "Output line too long: increase MAX_OUTPUT and recompile.^";\r
+ DoQuit();\r
+ }\r
+ theOutput->outputLen = c;\r
+ outputLen++;\r
+];\r
+\r
+[ PutUpper c; PutChar(glk_char_to_upper(c)); ];\r
+\r
+[ PutLower c; PutChar(glk_char_to_lower(c)); ];\r
+\r
+[ PutSpace n;\r
+ if (n < 1) n = 1;\r
+ if (outputLen && theOutput->(outputLen-1) ~= SPACE)\r
+ while (n-- > 0) PutChar(SPACE);\r
+ nextWhite = NEXT_NONE;\r
+];\r
+\r
+[ PullSpace n\r
+ i;\r
+ for (i=0 : i<n : i++) if (theOutput->i ~= SPACE) break;\r
+ n = i;\r
+ for ( : i<outputLen : i++) theOutput->(i-n) = theOutput->i;\r
+ outputLen = outputLen - n;\r
+];\r
+\r
+[ PutNL n;\r
+! i j;\r
+ while (n--) {\r
+ if (outputLen) {\r
+! j = 0;\r
+! if (indentWithTabs) {\r
+! for (j=0 : j<outputLen : j++) if (theOutput->j ~= SPACE) break;\r
+! for (i=0 : i<j/indentSize : i++) print (char) TAB;\r
+! j = j - j%indentSize;\r
+! }\r
+ glk_put_buffer_stream(targetStream, theOutput, outputLen);\r
+ outputLen = 0;\r
+ glk_put_char_stream(targetStream, NEWLINE);\r
+ prevLineBlank = false;\r
+ }\r
+ else\r
+ if (~~prevLineBlank) {\r
+ glk_put_char_stream(targetStream, NEWLINE);\r
+ prevLineBlank = true;\r
+ }\r
+ }\r
+ nextWhite = NEXT_NONE;\r
+];\r
+\r
+! =================================================================================================\r
projects / inform-resources.git / commitdiff