Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Some cleanups.

  • Loading branch information...
commit 19a54403c2d1540e5747160c2b73cb0bb5f2d7a2 1 parent bf23081
@danmey authored
Showing with 156 additions and 0 deletions.
  1. +70 −0 lib/meta.4k
  2. +86 −0 lib/shader.4k
View
70 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 ;
+
View
86 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
Please sign in to comment.
Something went wrong with that request. Please try again.