Some cleanups.

lib/meta.4k

@@ -0,0 +1,70 @@
+| FourK - Concatenative, stack based, Forth like language optimised for
+|        non-interactive 4KB size demoscene presentations.
+|
+| Copyright (C) 2009, 2010, 2011 Wojciech Meyer, Josef P. Bernhart
+|
+| This program is free software: you can redistribute it and/or modify
+| it under the terms of the GNU General Public License as published by
+| the Free Software Foundation, either version 3 of the License, or
+| (at your option) any later version.
+|
+| This program is distributed in the hope that it will be useful,
+| but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+| GNU General Public License for more details.
+|
+| You should have received a copy of the GNU General Public License
+| along with this program.  If not, see <http://www.gnu.org/licenses/>.
+| ______________________________________________________________________
+|
+| This stuff provides basic framework for runtime meta-programming
+|
+
+require" lib/stackx.4k"
+
+
+create token-table 512 allot 
+variable ptr token-table ptr !
+variable #tokens 0 #tokens !
+
+
+| Bind some useful functions
+2 ccall: malloc
+3 ccall: puts
+: libc " /usr/lib/libc.so" lib ;
+: function >r sym r> cells add-handle ;
+: token-imports ( -- )
+    libc " malloc" 1 function
+    libc " puts" 1 function ;
+|
+| Copy string to malloced block
+: malloc-token ( cstr -- cstr )
+    dup count dup 1+ malloc swap
+    1- 0 do over over swap i + c@ swap i + c! loop swap drop dup dup count + 0 swap c!  ;
+| Get token as Forth string 
+: tok ( token -- str n ) dup c@ swap 1+ swap ;
+|
+| DeclareX
+: declarex ( -- )
+    here @ >r ptr @ here ! token dup c, 1- 0
+    do dup i + c@ c, loop 0 c,
+    here @ r> here !
+    ptr @ tok 2dup (:) drop rliteral postpone malloc-token postpone >x postpone ; ptr ! 0 ptr @ c! #tokens 1+! ;
+|
+| Concat two malloced blocks, and create the third one
+: concat-malloc ( str1 str2 -- str3 )
+    dup count >r swap dup count r> 1+ + malloc ( str2 str1 str3 )
+    dup >r here @ >r here ! dup count 1- 0  do dup i + c@ c, loop drop
+    dup count 0  do dup i + c@ c, loop drop
+    r> here ! r> ;
+|
+;
+: malloc-c >r 2 malloc dup 1+ 0 swap c! dup r> swap c! ;
+: malloc-c: key malloc-c ;
+: malloc-nil 0 malloc-c ;
+: malloc-space 32 malloc-c ;
+: Type declarex ;
+: Ident declarex ;
+| Concat words on the X-stack
+: |> x> x> concat-malloc >x  ;
+

lib/shader.4k

@@ -0,0 +1,86 @@
+| FourK - Concatenative, stack based, Forth like language optimised for
+|        non-interactive 4KB size demoscene presentations.
+|
+| Copyright (C) 2009, 2010, 2011 Wojciech Meyer, Josef P. Bernhart
+|
+| This program is free software: you can redistribute it and/or modify
+| it under the terms of the GNU General Public License as published by
+| the Free Software Foundation, either version 3 of the License, or
+| (at your option) any later version.
+|
+| This program is distributed in the hope that it will be useful,
+| but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+| GNU General Public License for more details.
+|
+| You should have received a copy of the GNU General Public License
+| along with this program.  If not, see <http://www.gnu.org/licenses/>.
+| ______________________________________________________________________
+| This stuff is a live example of generating shader code at runtime
+| using meta.4k framework.
+| ______________________________________________________________________
+
+
+
+require" lib/meta.4k"
+
+Type vec3 Type vec4 Type mat3 Type float Type void
+Ident gl_Vertex Ident gl_Normal Ident gl_Color Ident gl_MultiTexCoordX
+Ident gl_ModelViewMatrix Ident gl_ModelViewProjectionMatrix
+Ident gl_NormalMatrix Ident gl_BackColor Ident gl_TexCoord
+Ident gl_Position
+
+Ident v1 Ident v2 Ident shader
+Ident x Ident y Ident z Ident xy Ident yx Ident xz Ident zx Ident yz
+Ident zy Ident xyz Ident xzy Ident zxy Ident zyx
+
+: op> malloc-c >x ;
+: space 32 op> ;
+: lpar c: ( op> ;
+: rpar c: ) op> ;
+: lbra c: { op> ;
+: rbra c: } op> ;
+: infix> op> swapx |> |> ;
+: comma> c: , infix> ;
+: ~! c: = infix> ;
+: ~* c: * infix> ;
+: ~; c: ; op> swapx |> ;
+: ,, 32 infix> ;
+: ~. c: . infix> ;
+: Function
+    x> >r
+    dup 1 = 0=
+    if
+        2
+        do
+            comma>
+        loop
+    else drop then
+    lpar r> >x space void |> |> |> |> rpar swapx |> lbra swapx |> ;
+: Fun
+    x> >r
+    lpar r> >x space void |> |> |> rpar swapx |> lbra swapx |> ;
+: printc dup count type ;
+
+: Beg lbra ;
+: End rbra swapx |> swapx |> ;
+: Var ,,  ;
+
+: main
+    0 #tokens !
+    token-table ptr !
+    token-imports
+
+    v1 vec3 ,, v2 vec3 ,, shader 2 Function
+      gl_ModelViewMatrix gl_Vertex ~* gl_Position ~! ~;
+    End x> printc cr cr
+
+    shader Fun
+      v1 vec3 Var ~;
+      v2 vec3 Var ~;
+      xy v1 ~. zx v1 ~. ~* v2 ~! ~; 
+      gl_ModelViewMatrix gl_Vertex ~* gl_Position ~! ~;
+    End x> printc cr cr
+;
+
+main