mplisp

miniPicoLisp with FFI and modules for Buddy BDD library, OpenGL, Gtk and GMP
git clone https://logand.com/git/mplisp.git/
Log | Files | Refs

pyramids.l (4137B)

      1 # 03mar08jk
      2 # (c) Jon Kleiser
      3 
      4 # An OpenGL demo showing twelve pyramids chained together.
      5 # The chain folds and unfolds. When completely folded, it is the shape of a cube.
      6 
      7 (load "@simul/gl/lib.l")
      8 
      9 (setq *WinWidth 1024 *WinHeight 680)
     10 (setq *AngleX 0.0 *AngleY 0.0)
     11 (setq *LastX 0 *LastY 0)
     12 (setq *Sin45 0.70710678)
     13 (setq *FoldTime 0.0)
     14 
     15 (de initGL (Width Height)
     16 	(gl:ClearColor 0.6 0.8 0.9 0)	# the background color
     17 	(gl:ClearDepth 1.0)
     18 	(gl:DepthFunc GL_LESS)
     19 	(gl:Enable GL_DEPTH_TEST)
     20 	(gl:ShadeModel GL_FLAT)
     21 	
     22 	(gl:Enable GL_LIGHTING)
     23 	(gl:Enable GL_LIGHT0)
     24 	(gl:Disable GL_CULL_FACE)
     25 	(gl:Enable GL_BLEND)
     26 	(gl:BlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
     27 	(gl:ColorMaterial GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE)
     28 	(gl:Enable GL_COLOR_MATERIAL)
     29 	
     30 	(gl:MatrixMode GL_PROJECTION)
     31 	(gl:LoadIdentity)
     32 	(glu:Perspective 45.0 (*/ Width 1.0 Height) 0.1 100.0)
     33 	(gl:MatrixMode GL_MODELVIEW) )
     34 
     35 (glut:Init)
     36 # Set display mode: RGBA color, Double buffer, Alpha support, Depth buffer
     37 (glut:InitDisplayMode (| GLUT_RGBA GLUT_DOUBLE GLUT_ALPHA GLUT_DEPTH))
     38 (glut:InitWindowSize *WinWidth *WinHeight)
     39 (glut:InitWindowPosition 10 50)
     40 (glut:CreateWindow "Folding Pyramids")
     41 
     42 (initGL *WinWidth *WinHeight)
     43 
     44 (de drawPyramid ()
     45 	(gl:Begin GL_TRIANGLES)
     46 	(gl:Normal3f (- *Sin45) 0.0 *Sin45)
     47 	(gl:Vertex3f 1.0 1.0 1.0)	# 0
     48 	(gl:Vertex3f 0.0 2.0 0.0)	# 1
     49 	(gl:Vertex3f 0.0 0.0 0.0)	# 2
     50 	
     51 	(gl:Normal3f 0.0 (- *Sin45) *Sin45)
     52 	(gl:Vertex3f 1.0 1.0 1.0)	# 0
     53 	(gl:Vertex3f 0.0 0.0 0.0)	# 2
     54 	(gl:Vertex3f 2.0 0.0 0.0)	# 3
     55 	
     56 	(gl:Normal3f *Sin45 *Sin45 0.0)
     57 	(gl:Vertex3f 1.0 1.0 1.0)	# 0
     58 	(gl:Vertex3f 2.0 0.0 0.0)	# 3
     59 	(gl:Vertex3f 0.0 2.0 0.0)	# 1
     60 	
     61 	(gl:Normal3f 0.0 0.0 -1.0)
     62 	(gl:Vertex3f 2.0 0.0 0.0)	# 3
     63 	(gl:Vertex3f 0.0 0.0 0.0)	# 2
     64 	(gl:Vertex3f 0.0 2.0 0.0)	# 1
     65 	(gl:End) )
     66 
     67 (displayFunc ()
     68 	(setq PyrRot (+ (ext:Cos *FoldTime 45.0) 45.0))
     69 	(gl:Clear (| GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
     70 	(gl:LoadIdentity)
     71 	(gl:Translatef 0.0 -0.4 -11.0)
     72 	(gl:Rotatef *AngleX 1 0 0)
     73 	(gl:Rotatef *AngleY 0 1 0)
     74 	(gl:Rotatef (- (/ PyrRot 2)) 0 1 0)
     75 	(gl:PushMatrix)
     76 	
     77 	(gl:Color4f 1.0 0.7 0.0 1.0)		# yellow
     78 	(drawPyramid)	# 1
     79 	
     80 	(gl:Rotatef PyrRot 0 1 0)
     81 	(gl:Rotatef 90.0 0 0 1)
     82 	(gl:Color4f 0.4 0.0 0.6 1.0)		# violet
     83 	(drawPyramid)	# 2
     84 	
     85 	(gl:Translatef 0.0 2.0 0.0)
     86 	(gl:Rotatef PyrRot 0 1 0)
     87 	(gl:Rotatef 180.0 0 0 1)
     88 	(gl:Color4f 1.0 0.2 0.0 1.0)		# red
     89 	(drawPyramid)	# 3
     90 	
     91 	(gl:Rotatef (- PyrRot) 1 0 0)
     92 	(gl:Rotatef -90.0 0 0 1)
     93 	(gl:Color4f 1.0 0.7 0.0 1.0)		# yellow
     94 	(drawPyramid)	# 4
     95 	
     96 	(gl:Translatef 2.0 0.0 0.0)
     97 	(gl:Rotatef (- PyrRot) 1 0 0)
     98 	(gl:Rotatef 180.0 0 0 1)
     99 	(gl:Color4f 0.4 0.0 0.6 1.0)		# violet
    100 	(drawPyramid)	# 5
    101 	
    102 	(gl:Rotatef PyrRot 0 1 0)
    103 	(gl:Rotatef 90.0 0 0 1)
    104 	(gl:Color4f 1.0 0.2 0.0 1.0)		# red
    105 	(drawPyramid)	# 6
    106 	
    107 	(gl:Translatef 0.0 2.0 0.0)
    108 	(gl:Rotatef PyrRot 0 1 0)
    109 	(gl:Rotatef 180.0 0 0 1)
    110 	(gl:Color4f 1.0 0.7 0.0 1.0)		# yellow
    111 	(drawPyramid)	# 7
    112 
    113 	(gl:PopMatrix)
    114 
    115 	(gl:Translatef 2.0 0.0 0.0)
    116 	(gl:Rotatef (- PyrRot) 1 0 0)
    117 	(gl:Rotatef 180.0 0 0 1)
    118 	(gl:Color4f 1.0 0.2 0.0 1.0)		# red
    119 	(drawPyramid)	# 12
    120 	
    121 	(gl:Rotatef PyrRot 0 1 0)
    122 	(gl:Rotatef 90.0 0 0 1)
    123 	(gl:Color4f 0.4 0.0 0.6 1.0)		# violet
    124 	(drawPyramid)	# 11
    125 	
    126 	(gl:Translatef 0.0 2.0 0.0)
    127 	(gl:Rotatef PyrRot 0 1 0)
    128 	(gl:Rotatef 180.0 0 0 1)
    129 	(gl:Color4f 1.0 0.7 0.0 1.0)		# yellow
    130 	(drawPyramid)	# 10
    131 	
    132 	(gl:Rotatef (- PyrRot) 1 0 0)
    133 	(gl:Rotatef -90.0 0 0 1)
    134 	(gl:Color4f 1.0 0.2 0.0 1.0)		# red
    135 	(drawPyramid)	# 9
    136 
    137 	(gl:Translatef 2.0 0.0 0.0)
    138 	(gl:Rotatef (- PyrRot) 1 0 0)
    139 	(gl:Rotatef 180.0 0 0 1)
    140 	(gl:Color4f 0.4 0.0 0.6 1.0)		# violet
    141 	(drawPyramid)	# 8
    142 
    143 	(gl:Flush)
    144 	(glut:SwapBuffers) )
    145 
    146 (reshapeFunc (Width Height)
    147 	(gl:Viewport 0 0 Width Height)
    148 	(gl:MatrixMode GL_PROJECTION)
    149 	(gl:LoadIdentity)
    150 	(glu:Perspective 45.0 (*/ Width 1.0 Height) 0.1 100.0)
    151 	(gl:MatrixMode GL_MODELVIEW) )
    152 
    153 (mouseFunc (Btn State X Y)
    154 	(setq *LastX X *LastY Y) )
    155 
    156 (motionFunc (X Y)
    157 	(inc '*AngleX (* (- Y *LastY) 1.0))
    158 	(inc '*AngleY (* (- X *LastX) 1.0))
    159 	(setq *LastX X *LastY Y)
    160    (glut:PostRedisplay) )
    161 
    162 (de myTimer (Val)
    163 	(inc '*FoldTime 0.2)
    164 	(glut:PostRedisplay)
    165 	(timerFunc 20 myTimer 0) )
    166 
    167 (timerFunc 20 myTimer 0)
    168 
    169 (glut:MainLoop)