Register to post in forums, or Log in to your existing account
 

Post new topic  Reply to topic     Home » Forums » zApp Developers
theNerd
Adept


Joined: 01 Mar 2005
Posts: 277

PostPosted: Mon Oct 10, 2005 7:41 pm   

16 Bit DOS Compiler In zApp
 
Here is a simple Open Source DOS Compiler (originally written by Kinex in VB) that I converted over to zApp for the fun of it. It works but has many bugs that I need to fix. I can only work on this during my lunches so as I fix and improve it I will post the zApp source here.

What needs to be done:
* Bug fixing
* Syntax Coloring
* Converting some VBScript code (ex. FileSystemObject) to zApp's code (ex. File .Stream)
* Right now it defaults to compiling to "c:\test.exe". This will be user definable rather than hard coded.
* Add example code it can compile
* Eventually adding new commands.


Code:
<?xml version='1.0' encoding='ISO-8859-1' ?>
<!DOCTYPE zapp [
  <!ENTITY AppTitle "16 Bit DOS Compiler">
  <!ENTITY OrigAuthor "Kinex">
  <!ENTITY AppAuthor "Steven C Picard">
  <!ENTITY AppVersion "0.09">
  <!ENTITY AppURL "http://www.kidev.com/devres/?page=home">
  ]>
<zapp>
  <action name='MemoNew' action='_MemoNew'>
    MemoNew.Format = "Text"
    NewTab
    MemoNew.Target = CurrentMemo.Name
  </action>
  <action name='MemoOpen' action='_MemoOpen'>
    NewTab
    MemoOpen.Target = CurrentMemo.Name
  </action>
  <action name='OnStart' Caption='Start' image='play'>
     StartCompile
  </action>
  <toolbar name='mainmenu' Fullsize='true'>
    <menu caption='&amp;File'>
      <item action='MemoNew'/>
      <item action='MemoOpen'/>
      <itemsep/>
      <item action='_MemoSave'/>
      <item action='_MemoSaveAs'/>
      <itemsep/>
      <item action='_MemoPageSetup'/>
      <item action='_MemoPrintPreview'/>
      <item action='_MemoPrint'/>
      <itemsep/>
      <item action='_FileExit'/>
    </menu>
    <menu caption='&amp;Edit'>
      <item action='_MemoUndo'/>
      <item action='_MemoRedo'/>
      <itemsep/>
      <item action='_EditCut'/>
      <item action='_EditCopy'/>
      <item action='_EditPaste'/>
      <itemsep/>
      <item action='_MemoFind'/>
      <item action='_MemoFindNext'/>
      <item action='_MemoReplace'/>
      <itemsep/>
      <item action='_MemoCharCase'/>
      <itemsep/>
      <item action='_EditSelectAll'/>
    </menu>
    <menu caption='&amp;Run'>
       <item caption='Start' action='OnStart'/>
    </menu>
    <menu caption='&amp;View'>
      <item caption='Normal' script='core.themeindex = -1'/>
      <item caption='Standard' script='core.theme = "standard"'/>
      <item caption='Flat' script='core.theme = "flat"'/>
      <item caption='UltraFlat' script='core.theme = "ultraflat"'/>
      <item caption='Office11' script='core.theme = "office11"'/>
      <item caption='Aqua' script='core.theme = "aqua"'/>
      <item caption='Watercolor' script='core.theme = "watercolor"'/>
      <item caption='Plex' script='core.theme = "plex"'/>
      <item action='_ThemeSelect'/>
    </menu>
    <menu caption='&amp;Help'>
      <item caption='&amp;About' script='core.execwindow( "About")'/>
    </menu>
  </toolbar>
  <toolbar name='maintoolbar'>
    <item action='MemoOpen'/>
    <item action='_MemoSave'/>
    <item action='_MemoQuickPrint'/>
    <item action='OnStart'/>
  </toolbar>
  <window name='main' caption='&AppTitle;' width="640" height="480" focus='Memo'>
    <toolbar name='mainmenu'/>
    <toolbar name='maintoolbar' row='1'/>
    <ruler align='top'/>
    <var name='OnChange'>
      EditPages.ActivePage.Color = "mistyrose"
    </var>
    <var name='OnFileChange'>
      if not(IsNull(zEvent.Sender.Tab)) then
        zEvent.Sender.Tab.Caption = str.ExtractFilename( zEvent.Filename)
        zEvent.Sender.Tab.Color = "Window"
      end if
    </var>
    <script>
      TabNum = 0
      sub NewTab
        TabNum = TabNum + 1
        Set CurrentTab = core.AddControl( "tab", "tab" &amp; TabNum, "EditPages")
        Set CurrentMemo = core.AddControl( "memo", "memo" &amp; TabNum, "tab" &amp; TabNum)
        CurrentMemo.Align = "client"
        CurrentMemo.Spellcheck = true
        CurrentMemo.ConfirmSave = true
        CurrentMemo.OnChange = OnChange.Value
        CurrentMemo.OnFileChange = OnFileChange.Value
        CurrentTab.Caption = "untitled" &amp; TabNum
        EditPages.ActivePageName = CurrentTab.Name
      end sub
    </script>
    <pages name='EditPages' align='client' showclosebutton='true'>
      <tab name='MainTab' caption='untitled'>
        <memo name='Memo' align='client' fontname='Arial' fontsize='12' spellcheck='true' confirmsave='true'
          onChange='=OnChange' onFileChange='=OnFileChange'/>
      </tab>
    </pages>
    <script>
      Set CurrentMemo = core.FindControl("Memo")
      if (core.OptionCount > 0) then
        fName = core.OptionValue(1)
        CurrentMemo.LoadFromFile fName
        MainTab.caption = fName
      end if
    </script>
    <statusbar name='Status'/>
    <script>

      Dim Code
                  
      ' mod Compiler Variables
      Dim CodeSection() ' As Integer
      
      ' mod Errors Variables
      Dim pError ' As Boolean
      Dim Errors ' As String
      
      ' mod Parser
      Dim Source ' As String
      Dim SourcePos ' As Long
      
      ' mod Resources
      Dim DataSection() ' As Integer
      
      ' mod Symbols
      ' SYMBOL_TYPE (Replaces Enum)
      Const RES_STRING = 1
      Const RES_LABEL = 2
      Const RES_PROC = 3
      Const RES_WORD = 4
      
      Class SYMBOL_ITEM
          Public Name ' As String
          Public Offset ' As Long
          Public SYMBOL_TYPE ' As SYMBOL_TYPE
      End Class
      
      Dim uID ' As Long
      Dim UniqueID ' As Long
      
      Dim Symbols() ' As SYMBOL_ITEM
      
      ' mod Fixups
      Class FIXUP_ITEM
          Public Name ' As String
          Public Value ' As Integer
          Public Offset ' As Long
      End Class
      
      Dim Fixups() ' As FIXUP_ITEM
      
      ' mod Linker
      Const GENERIC_WRITE = &amp;H40000000
      Const GENERIC_READ = &amp;H80000000
      Const FILE_ATTRIBUTE_NORMAL = &amp;H80
      Const CREATE_ALWAYS = 2
      Const OPEN_ALWAYS = 4
      Const INVALID_HANDLE_VALUE = -1
      
      Dim HeadSection() ' As Integer
            
      function StartCompile()

         if len(Trim(memo.text)) = 0 then
            msgbox "Please enter some code to run."
            exit function
         end if
         
         Code = memo.text
         Compile "c:\text.exe"
         File.Launch "c:\text.exe", "", "", 5

      end function      
      
      ' ==============================================================
      
      ' mod Compiler Routines
      Sub InitCompiler()
          ReDim CodeSection(0) ' As Integer
      End Sub
      
      Sub Compile(sFile)
      
          InitErrors
          InitParser
          InitFixups
          InitSymbols
          InitCompiler
          InitResources
         
          'Reserve the first two Bytes for jump to 'main' entry
          AddCodeByte Array(&amp;HEB, &amp;H0)
          AddFixup "main", UBound(CodeSection)
          Parse
         
          DoFixups
          If pError = True Then
              InfMessage Errors: Exit Sub
          End If
          Link sFile
      
      End Sub
      
      Sub AddCodeWord(Words) ' Was ParamArray
      
          Dim i ' As Integer
         
          For i = 0 To UBound(Words)
              AddCodeByte Array(LoByte(CInt(Words(i))), HiByte(CInt(Words(i))))
          Next ' i
      
      End Sub
      
      Sub AddCodeByte(Bytes) ' ParamArray
      
          Dim i ' As Integer
         
          For i = 0 To UBound(Bytes)
              ReDim Preserve CodeSection(UBound(CodeSection) + 1) ' As Integer
              CodeSection(UBound(CodeSection)) = CByte(Bytes(i))
          Next ' i
      
      End Sub
      
      ' mod Errors Routines
      Sub InitErrors()
          Errors = ""
      End Sub
      
      Sub ErrMessage(Text) '  As String
          Errors = Errors &amp; Text &amp; " [" &amp; SourcePos &amp; "]" &amp; vbCrLf
          pError = True
      End Sub
      
      Sub InfMessage(Text) '  As String
          MsgBox Text, vbInformation, "LeDev Compiler"
          pError = False
      End Sub
      
      ' mod Expressions
      Function IsVariableExpression() ' As Boolean
          If (UCase(Mid(Source, SourcePos, 1)) >= "A" And UCase(Mid(Source, SourcePos, 1)) <= "Z") Then
              IsVariableExpression = True
          End If
      End Function
      
      Function IsStringExpression() ' As Boolean
          If Mid(Source, SourcePos, 1) = Chr(34) Then
              IsStringExpression = True
          End If
      End Function
      
      Function IsNumberExpression() ' As Boolean
          If IsNumeric(Mid(Source, SourcePos, 1)) Or Mid(Source, SourcePos, 1) = "-" Then
              IsNumberExpression = True
          End If
      End Function
      
      Function NumberExpression() ' As Integer
          SkipBlank
          While IsNumeric(Mid(Source, SourcePos, 1))
                  NumberExpression = NumberExpression &amp; Mid(Source, SourcePos, 1)
                  Skip 0
          Wend
      End Function
      
      Function VariableExpression() ' As String
             VariableExpression = Identifier
      End Function
      
      Function StringExpression() ' As String
          SkipBlank
          Symbol Chr(34)
          While Mid(Source, SourcePos, 1) <> Chr(34)
                  StringExpression = StringExpression &amp; Mid(Source, SourcePos, 1)
                  If Mid(Source, SourcePos, 1) = vbCr Or Mid(Source, SourcePos, 1) = "" Then
                      ErrMessage "unterminated string": Exit Function
                  End If
                  Skip 0
          Wend
          Symbol Chr(34)
      End Function
      
      ' mod Math
      Function HiByte(ByVal iWord ) ' As Byte
          HiByte = (iWord And &amp;HFF00&amp;) \ &amp;H100
      End Function
      
      Function LoByte(ByVal iWord) ' As Byte
          LoByte = iWord And &amp;HFF
      End Function
      
      ' mod Resources
      Sub InitResources()
          ReDim DataSection(0) ' As Integer
      End Sub
      
      Sub AddResourceWord(Name, Value) '  As String, As Integer
          AddSymbol Name, UBound(DataSection) + 2, RES_WORD
          AddDataWord Value
      End Sub
      
      Sub AddResourceSpace(Value) '  As Integer
          Dim i ' As Integer
          For i = 0 To Value
              AddDataByte Asc("$")
          Next ' i
      End Sub
      
      Sub AddResourceString(Name, Value) '  As String  As String
          Dim i ' As Integer
      
          AddSymbol Name, UBound(DataSection) + 2, RES_STRING
         
          For i = 1 To Len(Value)
              AddDataByte Asc(Mid(Value, i, 1))
          Next ' i
         
          AddDataByte Asc("$")
      End Sub
      
      Sub AddDataWord(Value) '  As Integer
          AddDataByte LoByte(Value)
          AddDataByte HiByte(Value)
      End Sub
      
      Sub AddDataByte(Value) '  As Byte
          ReDim Preserve DataSection(UBound(DataSection) + 1) ' As Integer
          DataSection(UBound(DataSection)) = Value
      End Sub
      
      ' mod Syntax
      Sub Statement_Exit()
          Symbol "("
          Symbol ")"
          Terminator
          AddCodeByte Array(&amp;HB8, &amp;H0, &amp;H4C, &amp;HCD, &amp;H21)
          CodeBlock
      End Sub
      
      Sub Statement_Wait()
          Symbol "("
          Symbol ")"
          Terminator
          AddCodeByte Array(&amp;H31, &amp;HC0, &amp;HCD, &amp;H16)
          CodeBlock
      End Sub
      
      Sub Statement_Print(Ln) ' As Boolean
          Dim SymbolName ' As String
         
          Symbol "("
              If IsSymbol(Chr(34)) Then
                  uID = uID + 1
                  AddResourceString "Unique" &amp; uID, StringExpression ' &amp; Switch((Ln = True), vbCrLf, Null)
                  AddCodeByte Array(&amp;HBA, &amp;H0)
                  AddFixup "Unique" &amp; uID, 0
                  AddCodeByte Array(&amp;H0, &amp;HB4, &amp;H9, &amp;HCD, &amp;H21)
              Else
                  SymbolName = Identifier
                  AddCodeByte Array(&amp;HBA, &amp;H0)
                  AddFixup SymbolName, 0
                  AddCodeByte Array(&amp;H0, &amp;HB4, &amp;H9, &amp;HCD, &amp;H21)
              End If
      
          Symbol ")"
          Terminator
          CodeBlock
      End Sub
      
      Sub Statement_PosXY()
          Dim x ' As Byte
          Dim y ' As Byte
         
          Symbol "("
              x = NumberExpression
          Symbol ","
              y = NumberExpression
          Symbol ")"
          Terminator
          AddCodeByte Array(&amp;HB4, &amp;H2, &amp;HB6)
          AddCodeByte x
          AddCodeByte Array(&amp;HB2)
          AddCodeByte y
          AddCodeByte Array(&amp;HB7, &amp;H0, &amp;HCD, &amp;H10)
          CodeBlock
      End Sub
      
      Sub Statement_Cls()
          Symbol "("
          Symbol ")"
          Terminator
          AddCodeByte Array(&amp;HB4, &amp;H6, &amp;HB5, &amp;H0, &amp;HB1, &amp;H0, &amp;HB6, &amp;H18, &amp;HB2, &amp;H4F, &amp;HB7, &amp;H7, &amp;HB0, &amp;H0, &amp;HCD, &amp;H10, &amp;HB4, &amp;H2, &amp;HB6, &amp;H0, &amp;HB2, &amp;H0, &amp;HB7, &amp;H0, &amp;HCD, &amp;H10)
          CodeBlock
      End Sub
      
      Sub Statement_Jump()
          Dim Ident ' As String
          Symbol "("
              Ident = Identifier
          Symbol ")"
          Terminator
         
          AddCodeByte Array(&amp;HEB)
          AddCodeByte Array(&amp;H0)
          AddFixup Ident, UBound(CodeSection)
          CodeBlock
      End Sub
      
      Sub Statement_Call()
          Dim Ident ' As String
          Symbol "("
              Ident = Identifier
          Symbol ")"
          Terminator
         
          AddCodeByte Array(&amp;HEB)
          AddCodeByte Array(&amp;H0)
          AddFixup Ident, UBound(CodeSection)
          CodeBlock
      End Sub
      
      Sub Statement_CallProc(Ident) '  As String
          Symbol "("
          Symbol ")"
          Terminator
         
          AddCodeByte Array(&amp;HEB)
          AddCodeByte Array(&amp;H0)
          AddFixup Ident, UBound(CodeSection)
          CodeBlock
      End Sub
      
      Sub Statement_Read()
          Dim Length ' As Integer
          Symbol "("
          uID = uID + 1
          Length = NumberExpression
          AddResourceWord "Length", Length
          AddResourceString "read", ""
          AddResourceSpace Length
          AddCodeByte Array(&amp;HBA, &amp;H0)
          AddFixup "Length", 0
          AddCodeByte Array(&amp;H0, &amp;HB4, &amp;HA, &amp;HCD, &amp;H21)
          AddCodeByte Array(&amp;H1E, &amp;H7, &amp;HBF, &amp;H0)
          AddFixup "read", 0
          AddCodeByte Array(&amp;H0, &amp;HB0, &amp;HD, &amp;HF2, &amp;HAE, &amp;HC6, &amp;H45, &amp;HFF, &amp;H24)
          AddCodeByte Array(&amp;HB4, &amp;H2, &amp;HB2, &amp;HA, &amp;HCD, &amp;H21)
         
          Symbol ")"
          Terminator
          CodeBlock
      End Sub
      
      Sub Declare_Proc()
          AddSymbol Identifier, UBound(CodeSection), RES_PROC
          Symbol "("
          Symbol ")"
          Terminator
          CodeBlock
      End Sub
      
      Sub Statement_End()
         Terminator
         CodeBlock
      End Sub
      
      Sub Statement_If()
      
          Dim Expr(1) ' As String
          Dim ExprIsVariable(1) ' As Boolean
         
          Dim Ident ' As String
          Dim Operator ' As String
         
          Dim iID ' As Long
         
          iID = iID + UniqueID: UniqueID = UniqueID + 1
         
          Symbol "("
          If IsNumberExpression Then
              Expr(0) = NumberExpression
              ExprIsVariable(0) = False
          ElseIf IsVariableExpression Then
              Expr(0) = VariableExpression
              ExprIsVariable(0) = True
          End If
         
              If IsSymbol("=") Then
                  Operator = "=": Skip 0
              ElseIf IsSymbol("<") Then
                  Operator = "<": Skip 0
              ElseIf IsSymbol(">") Then
                  Operator = ">": Skip 0
              ElseIf IsSymbol("!") Then
                  Operator = "!": Skip 0
              Else: ErrMessage "expected operator = < > or !": Exit Sub
              End If
             
          If IsNumberExpression Then
              Expr(1) = NumberExpression
              ExprIsVariable(1) = False
          ElseIf IsVariableExpression Then
              Expr(1) = VariableExpression
              ExprIsVariable(1) = True
          End If
         
          Symbol ")"
         
          If ExprIsVariable(0) = False Then
              'mov bx,expr
              AddCodeByte Array(&amp;HBB)
              AddCodeWord Expr(1)
          Else
              'mov bx,[variable]
              AddCodeByte Array(&amp;H8B, &amp;H1E, &amp;H0)
              AddFixup Expr(0), 0
              AddCodeByte Array(&amp;H0)
          End If
         
          If ExprIsVariable(1) = False Then
              'mov dx,expr
              AddCodeByte Array(&amp;HBA)
              AddCodeWord Expr(1)
          Else
              'mov dx,[variable]
              AddCodeByte Array(&amp;H8B, &amp;H16, &amp;H0)
              AddFixup Expr(1), 0
              AddCodeByte Array(&amp;H0)
          End If
         
          'cmp bx, dx
          AddCodeByte Array(&amp;H39, &amp;HD3)
         
          If Operator = "=" Then
              AddCodeByte Array(&amp;H74, &amp;H0)
              AddFixup "then" &amp; iID, UBound(CodeSection)
              AddCodeByte Array(&amp;H75, &amp;H0)
              AddFixup "else" &amp; iID, UBound(CodeSection)
          End If
         
          If Operator = "<" Then
              AddCodeByte Array(&amp;H7C, &amp;H0)
              AddFixup "then" &amp; iID, UBound(CodeSection)
              AddCodeByte Array(&amp;H7D, &amp;H0)
              AddFixup "else" &amp; iID, UBound(CodeSection)
          End If
         
          If Operator = ">" Then
              AddCodeByte Array(&amp;H7F, &amp;H0)
              AddFixup "then" &amp; iID, UBound(CodeSection)
              AddCodeByte Array(&amp;H7E, &amp;H0)
              AddFixup "else" &amp; iID, UBound(CodeSection)
          End If
         
          If Operator = "!" Then
              AddCodeByte Array(&amp;H75, &amp;H0)
              AddFixup "then" &amp; iID, UBound(CodeSection)
              AddCodeByte Array(&amp;H74, &amp;H0)
              AddFixup "else" &amp; iID, UBound(CodeSection)
          End If
         
          'Parse
          Symbol "{":
          AddSymbol "then" &amp; iID, UBound(CodeSection), RES_LABEL
          CodeBlock
          AddCodeByte Array(&amp;HEB, &amp;H0)
          AddFixup "endif" &amp; iID, UBound(CodeSection)
          Symbol "}"
         
          SkipBlank
         
          AddSymbol "else" &amp; iID, UBound(CodeSection), RES_LABEL
         
          If IsIdent("else") Then
              Skip 4
              Symbol "{"
              CodeBlock
              Symbol "}"
          End If
         
          AddSymbol "endif" &amp; iID, UBound(CodeSection), RES_LABEL
         
      CodeBlock
      
      End Sub
      
      Sub Statement_While()
      
          Dim Expr(1) ' As String
          Dim ExprIsVariable(1) ' As Boolean
         
          Dim Ident ' As String
          Dim Operator ' As String
         
          Dim wID ' As Long
         
          wID = UniqueID: UniqueID = UniqueID + 1
         
          Symbol "("
          If IsNumberExpression Then
              Expr(0) = NumberExpression
              ExprIsVariable(0) = False
          ElseIf IsVariableExpression Then
              Expr(0) = VariableExpression
              ExprIsVariable(0) = True
          End If
         
              If IsSymbol("=") Then
                  Operator = "=": Skip 0
              ElseIf IsSymbol("<") Then
                  Operator = "<": Skip 0
              ElseIf IsSymbol(">") Then
                  Operator = ">": Skip 0
              ElseIf IsSymbol("!") Then
                  Operator = "!": Skip 0
              Else: ErrMessage "expected operator = < > or !": Exit Sub
              End If
             
          If IsNumberExpression Then
              Expr(1) = NumberExpression
              ExprIsVariable(1) = False
          ElseIf IsVariableExpression Then
              Expr(1) = VariableExpression
              ExprIsVariable(1) = True
          End If
         
          Symbol ")"
         
          AddSymbol "while" &amp; wID, UBound(CodeSection), RES_LABEL
         
          If ExprIsVariable(0) = False Then
              'mov bx,expr
              AddCodeByte &amp;HBB
              AddCodeWord Expr(1)
          Else
              'mov bx,[variable]
              AddCodeByte &amp;H8B, &amp;H1E, &amp;H0
              AddFixup Expr(0),0
              AddCodeByte &amp;H0
          End If
         
          If ExprIsVariable(1) = False Then
              'mov dx,expr
              AddCodeByte &amp;HBA
              AddCodeWord Expr(1),0
          Else
              'mov dx,[variable]
              AddCodeByte &amp;H8B, &amp;H16, &amp;H0
              AddFixup Expr(1),0
              AddCodeByte &amp;H0
          End If
         
          'cmp bx, dx
          AddCodeByte &amp;H39, &amp;HD3
         
          If Operator = "=" Then
              AddCodeByte &amp;H75, &amp;H0
              AddFixup "endwhile" &amp; wID, UBound(CodeSection)
          End If
         
          If Operator = "<" Then
              AddCodeByte &amp;H7D, &amp;H0
              AddFixup "endwhile" &amp; wID, UBound(CodeSection)
          End If
         
          If Operator = ">" Then
              AddCodeByte &amp;H7E, &amp;H0
              AddFixup "endwhile" &amp; wID, UBound(CodeSection)
          End If
         
          If Operator = "!" Then
              AddCodeByte &amp;H74, &amp;H0
              AddFixup "endwhile" &amp; wID, UBound(CodeSection)
          End If
         
          'Parse
          Symbol "{":
          CodeBlock
          AddCodeByte &amp;HEB, &amp;H0
          AddFixup "while" &amp; wID, UBound(CodeSection)
          Symbol "}"
         
          SkipBlank
         
          AddSymbol "endwhile" &amp; wID, UBound(CodeSection), RES_LABEL
         
          CodeBlock
      End Sub
      
      Sub Declare_Label()
          Symbol "("
          AddSymbol Identifier, UBound(CodeSection), RES_LABEL
          Symbol ")"
          Terminator
          CodeBlock
      End Sub
      
      Sub Declare_Word()
          Dim IdentName ' As String
          Dim ResWord ' As Integer
         
          Symbol "("
              IdentName = Identifier
          Symbol ","
              ResWord = NumberExpression
          Symbol ")"
          Terminator
         
          AddResourceWord IdentName, ResWord
          CodeBlock
      End Sub
      
      Sub Evaluate_Variable(Ident) '  As String
      
          SkipBlank
         
          If IsSymbol("+=") Then
              Symbol ("+"): Symbol ("=")
              AddCodeByte &amp;H81, &amp;H6, &amp;H0
              AddFixup Ident, 0
              AddCodeByte &amp;H0
              AddCodeWord NumberExpression
          End If
         
          If IsSymbol("-=") Then
              Symbol ("-"): Symbol ("=")
              AddCodeByte &amp;H81, &amp;H2E, &amp;H0
              AddFixup Ident, 0
              AddCodeByte &amp;H0
              AddCodeWord NumberExpression
          End If
         
          If IsSymbol("=") Then
              Symbol ("=")
              AddCodeByte &amp;HC7, &amp;H6, &amp;H0
              AddFixup Ident, 0
              AddCodeByte &amp;H0
              AddCodeWord NumberExpression
          End If
         
          Terminator
          CodeBlock
      End Sub
      
      Sub Declare_String()
      
          Dim IdentName ' As String
          Dim ResString ' As String
         
          Symbol "("
              IdentName = Identifier
          Symbol ","
              ResString = StringExpression
          Symbol ")"
          Terminator
         
          AddResourceString IdentName, ResString
          CodeBlock
      
      End Sub
      
      ' mod Symbols
      Sub InitSymbols()
          uID = 0
          UniqueID = 0
          ReDim Symbols(0) ' As SYMBOL_ITEM
          Set Symbols(0) = New SYMBOL_ITEM
      End Sub
      
      Sub AddSymbol(Name, Offset, TypeOfSymbol) ' As String, As Long,  As SYMBOL_TYPE
          ReDim Preserve Symbols(UBound(Symbols) + 1) ' As SYMBOL_ITEM
          Set Symbols(UBound(Symbols)) = New SYMBOL_ITEM
          Symbols(UBound(Symbols)).Name = Name
          Symbols(UBound(Symbols)).Offset = Offset
          Symbols(UBound(Symbols)).SYMBOL_TYPE = TypeOfSymbol
      End Sub
      
      ' mod Fixups
      Sub InitFixups()
          ReDim Fixups(0) ' As FIXUP_ITEM
          Set FixUps(0) = New FIXUP_ITEM
      End Sub
      
      Sub AddFixup(Name, Value) '  As String, Optional Value As Integer
          ReDim Preserve Fixups(UBound(Fixups) + 1) ' As FIXUP_ITEM
          Set Fixups(UBound(Fixups)) = New FIXUP_ITEM
          Fixups(UBound(Fixups)).Name = Name
          Fixups(UBound(Fixups)).Value = Value
          Fixups(UBound(Fixups)).Offset = UBound(CodeSection)
      End Sub
      
      Sub DoFixups()
          Dim i ' As Integer
          Dim ii ' As Integer
          Dim Found ' As Boolean
         
          Found = False
         
          For i = 1 To UBound(Fixups)
              For ii = 1 To UBound(Symbols)
                  If LCase(Symbols(ii).Name) = LCase(Fixups(i).Name) Then
                          If Symbols(ii).SYMBOL_TYPE = RES_STRING Then
                              CodeSection(Fixups(i).Offset) = UBound(CodeSection) + Symbols(ii).Offset
                          ElseIf Symbols(ii).SYMBOL_TYPE = RES_WORD Then
                              CodeSection(Fixups(i).Offset) = UBound(CodeSection) + Symbols(ii).Offset
                          ElseIf Symbols(ii).SYMBOL_TYPE = RES_LABEL Then
                              CodeSection(Fixups(i).Offset) = Symbols(ii).Offset - Fixups(i).Value
                          ElseIf Symbols(ii).SYMBOL_TYPE = RES_PROC Then
                              CodeSection(Fixups(i).Offset) = Symbols(ii).Offset - Fixups(i).Value
                          End If
                      Found = True
                  End If
              Next ' ii
              If Found = False Then ErrMessage "'" &amp; Fixups(i).Name &amp; "' is undefined!" Else Found = False
          Next ' i
      End Sub
      
      
      ' mod Linker
      Public Sub InitHeader()
          ReDim HeadSection(0) ' As Integer
          AddHeadBytes Array(&amp;H4D, &amp;H5A, 34 + UBound(CodeSection) + UBound(DataSection), &amp;H0, _
                       &amp;H1, &amp;H0, &amp;H0, &amp;H0, &amp;H2, &amp;H0, &amp;H0, &amp;H1, &amp;HFF, &amp;HFF, &amp;H7, &amp;H0, _
                       &amp;H0, &amp;H10, &amp;H0, &amp;H0, &amp;H0, &amp;H0, &amp;H0, &amp;H0, &amp;H1C, &amp;H0, &amp;H0, &amp;H0, _
                       &amp;H0, &amp;H0, &amp;H0, &amp;H0, &amp;HE, &amp;H1F)
      End Sub
      
      Sub AddHeadBytes(Bytes)
         
          Dim i ' As Integer
         
          For i = 0 To UBound(Bytes)
              ReDim Preserve HeadSection(UBound(HeadSection) + 1) ' As Integer
              HeadSection(UBound(HeadSection)) = Bytes(i)
          Next ' i
         
      End Sub
      
      Sub Link(sFile) '  As String
      
          Dim i
      
          Dim oFS ' As FileSystemObject
          Set oFS = CreateObject("Scripting.FileSystemObject")
      
          Dim oTS ' As TextStream
      
          If oFS.FileExists(sFile) Then
              oFS.DeleteFile sFile, True
          End If
      
          Set oTS = oFS.CreateTextFile(sFile, True)
      
          InitHeader
      
          For i = 1 To UBound(HeadSection)
              oTS.Write Chr(HeadSection(i))
          Next ' i
      
          For i = 1 To UBound(CodeSection)
              oTS.Write Chr(CodeSection(i))
          Next ' i
      
          For i = 1 To UBound(DataSection)
              oTS.Write Chr(DataSection(i))
          Next ' i
      
          oTS.Close
          Set oTS = Nothing
          Set oFS = Nothing
             
          InfMessage "compilation process complete." &amp; vbCrLf &amp; sFile &amp; vbCrLf &amp; _
                     UBound(HeadSection) + _
                     UBound(CodeSection) + _
                     UBound(DataSection) &amp; _
                     " bytes written."
         
          'ShellExecute 0, "open", sFile, "", "C:\", 1
                     
      End Sub
      
      ' mod Parser
      Sub InitParser()
          pError = False
          Source = Code
      End Sub
      
      Sub Parse()
          SourcePos = 1
          CodeBlock
      End Sub
      
      Sub CodeBlock()
          Dim Ident ' As String
         
         
          Ident = Identifier
         
          If Ident = "" Then Exit Sub: If pError = True Then Exit Sub
         
          Select Case LCase(Ident)
              Case "string": Declare_String
              Case "int": Declare_Word
              Case "wait": Statement_Wait
              Case "posxy": Statement_PosXY
              Case "cls": Statement_Cls
              Case "read": Statement_Read
              Case "print": Statement_Print False
              Case "println": Statement_Print True
              Case "label": Declare_Label
              Case "proc": Declare_Proc
              Case "end": Statement_End
              Case "jump": Statement_Jump
              Case "call": Statement_Call
              Case "if": Statement_If
              Case "while": Statement_While
              Case "exit": Statement_Exit
              Case Else
                  If IsVariable(Ident) Then
                      Evaluate_Variable Ident
                  ElseIf IsProc(Ident) Then
                      Statement_CallProc Ident
                  Else
                      ErrMessage "unknown Identifier '" &amp; Ident &amp; "'"
                  End If
          End Select
      End Sub
      
      Function Identifier() ' As String
         
          SkipBlank
         
          While (UCase(Mid(Source, SourcePos, 1)) >= "A" And _
                 UCase(Mid(Source, SourcePos, 1)) <= "Z")
                 Identifier = Identifier &amp; Mid(Source, SourcePos, 1)
                  Skip 0
          Wend
      
      End Function
      
      
      Sub Skip(NumberOfChars)
          SourcePos = SourcePos + 1 + NumberOfChars
      End Sub
      
      Sub SkipBlank()
          While Mid(Source, SourcePos, 1) = " " Or _
                Mid(Source, SourcePos, 1) = vbCr Or _
                Mid(Source, SourcePos, 1) = vbLf Or _
                Mid(Source, SourcePos, 1) = vbTab
              Skip 0
          Wend
      End Sub
      
      Sub Symbol(Value)
          SkipBlank
          If Mid(Source, SourcePos, 1) = Value Then
              Skip 0
          Else
              ErrMessage "expected symbol '" &amp; Value &amp; "' but found '" &amp; Mid(Source, SourcePos, 1) &amp; "'"
          End If
      End Sub
      
      Function IsVariable(Ident) ' As Boolean
          Dim i ' As Integer
          For i = 1 To UBound(Symbols)
              If Symbols(i).SYMBOL_TYPE = RES_WORD Then
                  If Symbols(i).Name = Ident Then
                      IsVariable = True
                      Exit Function
                  End If
              End If
          Next ' i
      End Function
      
      Function IsProc(Ident) ' As Boolean
          Dim i ' As Integer
          For i = 1 To UBound(Symbols)
              If Symbols(i).SYMBOL_TYPE = RES_PROC Then
                  If Symbols(i).Name = Ident Then
                      IsProc = True
                      Exit Function
                  End If
              End If
          Next ' i
      End Function
      
      Function IsIdent(Word) ' As Boolean
          If LCase(Mid(Source, SourcePos, Len(Word))) = LCase(Word) Then IsIdent = True
      End Function
      
      Function IsSymbol(Value) ' As Boolean
          If Mid(Source, SourcePos, Len(Value)) = Value Then IsSymbol = True
      End Function
      
      Sub Terminator()
          If Mid(Source, SourcePos, 1) = ";" Then
              Skip 0
          Else
              ErrMessage "expected terminator (;) but found '" &amp; Mid(Source, SourcePos, 1)
          End If
      End Sub
      
      Sub Switch(vExp,vTrue,vFalse)
         If CBool(vExp) Then
            Switch = vTrue
         Else
            Switch = vFalse
         End If
      End Sub
    </script>   
  </window>
  <window caption='About' name='about' width='400' height='300' borderstyle='dialog' nosave='true' position='screencenter' color='#C4D2ED'>
    <panel align='bottom' height='28'>
      <label left='0' top='0' fullwidth='true' fullheight='true' color='#C4D2ED' transparent='false'/>
      <button kind='OK' autocenter='true' top='0'/>
    </panel>
    <panel borderouter='lowered' align='client'>
      <label align='Client'><![CDATA[<p align="center"><br><b>&AppTitle;</b><br><br>
Version &AppVersion;<br><br>
<br>Original Open Source Author: <b>&OrigAuthor;</b><BR><a href="&AppURL;">&AppURL;</a><br><br>
Converted To zAPP By: <b>&AppAuthor;</b>
</p>]]></label>
    </panel>
  </window>
</zapp>


Here is some sample code to run:
Code:
string(given,"21");

proc main();
   print("Enter the value 21 and then press ENTER to continue: ");
   read(3);
   if(read=given) {
      print("You got it right!");
   }
        else {
                print("Wrong entry!");
        }
        wait();
   exit();
end;


Last edited by theNerd on Mon Oct 10, 2005 7:59 pm; edited 1 time in total
Reply with quote
theNerd
Adept


Joined: 01 Mar 2005
Posts: 277

PostPosted: Mon Oct 10, 2005 7:53 pm   
 
I am hoping to try and kickstart some interest in zApp. During my lunches (that I am actually at work) I will try to write quick little zApps that are fun.

Some ideas that I will pull from:
* Log viewer (I have some big ideas for this)
* Adventure creator
* Simple custom programming language that converts to zApp code
* Address book (good example for newbies)
* Form designer for zApp
Reply with quote
theNerd
Adept


Joined: 01 Mar 2005
Posts: 277

PostPosted: Tue Dec 13, 2005 9:39 pm   
 
Just in case there was even 1 person out there wondering why I never continued posting updates and other bits of stuff here, I stopped because my time is very limited (like all of ours, I'm sure) and it is best spent on other things. I saw zero interest so I saw no reason to continue pursuing any effort in developing good sample applications.

Maybe a time will come when Zugg can spend more time on zApp but right now he has more important things. As he stated in another post, there are like 12 people interested in zApp (and Iím still sure he counted me twice.) It actually pains me to see this. Zugg put countless hours into the development of a *very* awesome tool. To me, he has proven that he is a master programmer as well as an ingenious developer. However, it seems that there is less time in the day, anymore, and we have to make decisions on how we are to spend that limited time. I believe he has chosen wisely under the current circumstances.

My best of wishes to Zugg and his business and the zMUD community. One day I hope to see zApp become a thriving community but until then, my best wishes to all.
Reply with quote
Display posts from previous:   
Post new topic   Reply to topic     Home » Forums » zApp Developers All times are GMT
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
© 2009 Zugg Software. Hosted on Wolfpaw.net