Skip to content

Commit

Permalink
[irteus/irtglc.c] add irtglc.c
Browse files Browse the repository at this point in the history
  • Loading branch information
furushchev committed Jul 14, 2016
1 parent 831e31d commit c4820eb
Show file tree
Hide file tree
Showing 4 changed files with 108 additions and 13 deletions.
11 changes: 7 additions & 4 deletions irteus/Makefile
Expand Up @@ -98,6 +98,7 @@ IRTEUSGL_L=$(addsuffix .l,$(IRTEUSGL))
IRTCOBJECTS=$(INSTALLOBJDIR)/irtc.$(OSFX) $(INSTALLOBJDIR)/irtgeoc.$(OSFX)
IRTGCOBJECTS=$(INSTALLOBJDIR)/CPQP.$(OSFX) $(INSTALLOBJDIR)/euspqp.$(OSFX)
IRTIMGCOBJECTS=$(INSTALLOBJDIR)/euspng.$(OSFX)
IRTGLCOBJECTS=$(INSTALLOBJDIR)/irtglc.$(OSFX)
NROBJECTS=$(INSTALLOBJDIR)/nr.$(OSFX)

all: $(LIBNR) $(LIBIRTEUS) $(LIBIRTEUSG) $(LIBIRTEUSX) $(LIBIRTEUSIMG) $(LIBIRTEUSGL) make-link install-irtext.l
Expand All @@ -116,8 +117,8 @@ $(LIBIRTEUSX): $(IRTEUSXOBJS)
$(LIBIRTEUSIMG): $(INSTALLLIBDIR)/jpegmemcd.$(LSFX) $(IRTEUSIMGOBJS) $(IRTIMGCOBJECTS)
$(LD) $(SOFLAGS) $(OUTOPT)$(LIBIRTEUSIMG) $(IRTEUSIMGOBJS) $(IRTIMGCOBJECTS) $(IMPLIB) $(IMPLIBIMG)

$(LIBIRTEUSGL): $(IRTEUSGLOBJS)
$(LD) $(SOFLAGS) $(OUTOPT)$(LIBIRTEUSGL) $(IRTEUSGLOBJS) $(IMPLIB)
$(LIBIRTEUSGL): $(IRTEUSGLOBJS) $(IRTGLCOBJECTS)
$(LD) $(SOFLAGS) $(OUTOPT)$(LIBIRTEUSGL) $(IRTEUSGLOBJS) $(IRTGLCOBJECTS) $(IMPLIB)

$(IRTEUSOBJS): $(OBJDIR)/compile_irt.log
$(OBJDIR)/compile_irt.log: $(IRTEUS_L)
Expand Down Expand Up @@ -200,9 +201,11 @@ $(INSTALLOBJDIR)/png.$(OSFX): png.l
$(INSTALLOBJDIR)/pgsql.$(OSFX): $(EUSDIR)/lib/llib/pgsql.l
$(INSTALLOBJDIR)/eusjpeg.$(OSFX): $(EUSDIR)/lisp/image/jpeg/eusjpeg.l

$(INSTALLOBJDIR)/irtc.$(OSFX): irtc.c $(filter-out $(INSTALLOBJDIR)/irtc.$(OSFX),$(IRTEUSOBJS) $(IRTEUSGOBJS) $(IRTGCOBJECTS) PQP/$(ARCHDIR)/libPQP-static.a $(IRTEUSXOBJS) $(INSTALLLIBDIR)/jpegmemcd.$(LSFX) $(IRTEUSIMGOBJS) $(IRTIMGCOBJECTS) $(IRTEUSGLOBJS))
$(INSTALLOBJDIR)/irtc.$(OSFX): irtc.c $(filter-out $(INSTALLOBJDIR)/irtc.$(OSFX),$(IRTEUSOBJS) $(IRTEUSGOBJS) $(IRTGCOBJECTS) PQP/$(ARCHDIR)/libPQP-static.a $(IRTEUSXOBJS) $(INSTALLLIBDIR)/jpegmemcd.$(LSFX) $(IRTEUSIMGOBJS) $(IRTIMGCOBJECTS) $(IRTEUSGLOBJS) $(IRTGLCOBJECTS))
$(CC) $(CFLAGS) -c irtc.c $(OBJOPT)$(INSTALLOBJDIR)/irtc.$(OSFX)
$(INSTALLOBJDIR)/irtgeoc.$(OSFX): irtgeoc.c $(filter-out $(INSTALLOBJDIR)/irtgeoc.$(OSFX), $(IRTEUSOBJS) $(IRTEUSGOBJS) $(IRTGCOBJECTS) PQP/$(ARCHDIR)/libPQP-static.a $(IRTEUSXOBJS) $(INSTALLLIBDIR)/jpegmemcd.$(LSFX) $(IRTEUSIMGOBJS) $(IRTIMGCOBJECTS) $(IRTEUSGLOBJS))
$(INSTALLOBJDIR)/irtglc.$(OSFX): irtglc.c $(filter-out $(INSTALLOBJDIR)/irtglc.$(OSFX),$(IRTEUSOBJS) $(IRTEUSGOBJS) $(IRTGCOBJECTS) PQP/$(ARCHDIR)/libPQP-static.a $(IRTEUSXOBJS) $(INSTALLLIBDIR)/jpegmemcd.$(LSFX) $(IRTEUSIMGOBJS) $(IRTIMGCOBJECTS) $(IRTEUSGLOBJS) $(IRTGLCOBJECTS))
$(CC) $(CFLAGS) -c irtglc.c $(OBJOPT)$(INSTALLOBJDIR)/irtglc.$(OSFX)
$(INSTALLOBJDIR)/irtgeoc.$(OSFX): irtgeoc.c $(filter-out $(INSTALLOBJDIR)/irtgeoc.$(OSFX), $(IRTEUSOBJS) $(IRTEUSGOBJS) $(IRTGCOBJECTS) PQP/$(ARCHDIR)/libPQP-static.a $(IRTEUSXOBJS) $(INSTALLLIBDIR)/jpegmemcd.$(LSFX) $(IRTEUSIMGOBJS) $(IRTIMGCOBJECTS) $(IRTEUSGLOBJS) $(IRTGLCOBJECTS))
$(CC) $(CFLAGS) -c irtgeoc.c $(OBJOPT)$(INSTALLOBJDIR)/irtgeoc.$(OSFX)
$(INSTALLOBJDIR)/CPQP.$(OSFX): CPQP.C
$(CXX) $(CXXFLAGS) -c CPQP.C $(OBJOPT)$(INSTALLOBJDIR)/CPQP.$(OSFX)
Expand Down
2 changes: 1 addition & 1 deletion irteus/irtext.l
Expand Up @@ -55,7 +55,7 @@
(load-library
(format nil "~A~A/lib/libirteusgl"
*eusdir* (unix:getenv "ARCHDIR"))
'("irtglrgb" "irtgl" "irtviewer"))
'("irtglrgb" "irtgl" "irtglc" "irtviewer"))
)

(unless (member (pathname-name *program-name*)
Expand Down
25 changes: 17 additions & 8 deletions irteus/irtgl.l
Expand Up @@ -99,6 +99,22 @@
(error "could not find viewers for ~A" alist))))) ;; t
))

(defun transpose-image-rows (img &optional ret)
(let* ((h (send img :height))
(step (* (send img :width) (send img :components)))
(src (send img :entity)))
(cond
(ret
(unless (and (eq (send img :height) (send ret :height))
(eq (send img :width) (send ret :width))
(eq (send img :components) (send ret :components)))
(error "invalid return image format"))
(ctranspose-image-rows h step src (send ret :entity))
ret)
(t
(ctranspose-image-rows h step src)
img))))

(unless (assoc :color-org (send glviewsurface :methods))
(rplaca (assoc :color (send glviewsurface :methods)) :color-org))
(defmethod glviewsurface
Expand Down Expand Up @@ -194,14 +210,7 @@
(glReadPixels x y width height GL_DEPTH_COMPONENT GL_FLOAT fv)
(user::float-bytestring2dvector fv depthbuf)))
;; transpose
(let ((b (make-string (* width height 3))))
(dotimes (x width)
(dotimes (y height)
(dotimes (z 3)
(setf (elt b (+ (* (- height y 1) width 3) (* x 3) z))
(elt imgbuf (+ (* y width 3) (* x 3) z))))))
(instance image::color-image24 :init width height b))
))
(transpose-image-rows self)))
)

(defun draw-globjects (vwr draw-things &key (clear t) (flush t) (draw-origin 150) (draw-floor nil))
Expand Down
83 changes: 83 additions & 0 deletions irteus/irtglc.c
@@ -0,0 +1,83 @@
///////////////////////////////////////////////////////////////////////////////
///
/// $Id$
///
/// Copyright (c) 1987- JSK, The University of Tokyo. All Rights Reserved.
///
/// This software is a collection of EusLisp code for robot applications,
/// which has been developed by the JSK Laboratory for the IRT project.
/// For more information on EusLisp and its application to the robotics,
/// please refer to the following papers.
///
/// Toshihiro Matsui
/// Multithread object-oriented language euslisp for parallel and
/// asynchronous programming in robotics
/// Workshop on Concurrent Object-based Systems,
/// IEEE 6th Symposium on Parallel and Distributed Processing, 1994
///
/// Permission to use this software for educational, research
/// and non-profit purposes, without fee, and without a written
/// agreement is hereby granted to all researchers working on
/// the IRT project at the University of Tokyo, provided that the
/// above copyright notice remains intact.
///
// author: Yuki Furuta <furushchev@jsk.imi.i.u-tokyo.ac.jp>

#pragma init (register_irtglc)

#include "eus.h"

extern pointer ___irtglc();
static register_irtglc()
{ add_module_initializer("___irtglc", ___irtglc);}

#define colsize(p) (intval(p->c.ary.dim[1]))
#define rowsize(p) (intval(p->c.ary.dim[0]))
#define isimage(p) ((isarray(p) && \
p->c.ary.rank==makeint(2) && \
(elmtypeof(p->c.ary.entity)==ELM_CHAR || \
elmtypeof(p->c.ary.entity)==ELM_BYTE)))

pointer CTRANSPOSE_IMAGE_ROWS(ctx,n,argv)
register context *ctx;
register int n;
register pointer argv[];
/* (height step src-entity &optional dst-entity) */
{
int h,step,y;
char *src, *dst, *buf;

ckarg2(3,4);
h=ckintval(argv[0]); step=ckintval(argv[1]);
if (isstring(argv[2])) src=argv[2]->c.str.chars;
else src=(char*)bigintval(argv[2]);

printf("h: %d, step: %d\n", h,step);

if (n==3) {
buf=malloc(sizeof(char)*step);
for(y = 0; y < h/2; ++y) {
memcpy(buf, src + (h-y-1)*step, step);
memcpy(src + (h-y-1)*step, src + y*step, step);
memcpy(src + y*step, buf, step);
}
free(buf);
return(src);
} else {
if (isstring(argv[3])) dst=argv[3]->c.str.chars;
else dst=(char*)bigintval(argv[3]);
for(y = 0; y < h; ++y) {
memcpy(dst + y*step, src + (h-y-1)*step, step);
}
return(dst);}}

pointer ___irtglc(ctx,n,argv,env)
register context *ctx;
int n;
pointer argv[];
pointer env;
{
pointer mod=argv[0];
defun(ctx,"CTRANSPOSE-IMAGE-ROWS",mod,CTRANSPOSE_IMAGE_ROWS);
}

0 comments on commit c4820eb

Please sign in to comment.