/[cello]/cello/ix-polygon.lisp
ViewVC logotype

Contents of /cello/ix-polygon.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (show annotations)
Fri Apr 11 09:22:48 2008 UTC (6 years ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.5: +2 -0 lines
*** empty log message ***
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*-
2 #|
3
4 Copyright (C) 2004 by Kenneth William Tilton
5
6 This library is free software; you can redistribute it and/or
7 modify it under the terms of the Lisp Lesser GNU Public License
8 (http://opensource.franz.com/preamble.html), known as the LLGPL.
9
10 This library is distributed WITHOUT ANY WARRANTY; without even
11 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
13 See the Lisp Lesser GNU Public License for more details.
14
15 |#
16
17 (in-package :cello)
18
19 ;------------------------------------------------------------
20
21 (export! ix-polygon)
22 (defmodel ix-polygon (ix-view)
23 ((fore-color :initarg :fore-color :initform +black+ :accessor fore-color)
24 (poly-style :initarg :poly-style :initform nil :accessor poly-style)
25 (poly-thickness :initarg :poly-thickness :initform (u96ths 1) :accessor poly-thickness)
26 (poly-symmetry :initarg :poly-symmetry :initform nil :accessor poly-symmetry)
27 (vertices :initarg :vertices :initform nil :accessor vertices)))
28
29 (defmethod ix-paint ((self ix-polygon))
30 (let ((gh0 (ll self)) (gv0 (lt self)))
31 (flet ((g2d (vertex) (mkv2 (+ (car vertex) gh0) (+ (cdr vertex) gv0)))
32 (sym2d (vertex) (mkv2 (+ (cdr vertex) gh0) (+ (car vertex) gv0))))
33 (let ((vs (if (poly-symmetry self)
34 (append (mapcar #'g2d (vertices self))
35 (nreverse (mapcar #'sym2d (vertices self))))
36 (mapcar #'g2d (vertices self)))))
37
38 (with-matrix (nil)
39 (gl-line-width (poly-thickness self))
40 (gl-polygon-mode gl_front_and_back gl_fill)
41 (with-gl-begun (gl_triangles)
42 (dolist (v vs)
43 (gl-vertex3f (v2-h v) (v2-v v) 0)))
44 (ogl::glec :f3d))))))
45

  ViewVC Help
Powered by ViewVC 1.1.5