Permalink
Browse files

Some cleanups.

  • Loading branch information...
danmey committed Jun 11, 2011
1 parent bf23081 commit 19a54403c2d1540e5747160c2b73cb0bb5f2d7a2
Showing with 156 additions and 0 deletions.
  1. +70 −0 lib/meta.4k
  2. +86 −0 lib/shader.4k
View
@@ -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
@@ -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

0 comments on commit 19a5440

Please sign in to comment.