tests/gettime.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          getenv.cl
   6 ;;;; Purpose:       UFFI Example file to get time
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Mar 2002
   9 ;;;;
  10 ;;;; Copyright (c) 2002 Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; $Id: gettime.cl,v 1.5 2002/03/11 18:00:57 kevin Exp $
  13 ;;;;
  14 ;;;; This file is part of UFFI.
  15 ;;;;
  16 ;;;; UFFI is free software; you can redistribute it and/or modify
  17 ;;;; it under the terms of the GNU General Public License (version 2) as
  18 ;;;; published by the Free Software Foundation.
  19 ;;;;
  20 ;;;; UFFI is distributed in the hope that it will be useful,
  21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;;; GNU General Public License for more details.
  24 ;;;;
  25 ;;;; You should have received a copy of the GNU General Public License
  26 ;;;; along with UFFI; if not, write to the Free Software Foundation, Inc.,
  27 ;;;; 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  28 ;;;; *************************************************************************
  29
  30 (in-package :cl-user)
  31
  32 (uffi:def-foreign-type time-t :unsigned-long)
  33
  34 (uffi:def-struct tm
  35     (sec :int)
  36   (min :int)
  37   (hour :int)
  38   (mday :int)
  39   (mon :int)
  40   (year :int)
  41   (wday :int)
  42   (yday :int)
  43   (isdst :int))
  44
  45 (uffi:def-function ("time" c-time)
  46     ((time (* time-t)))
  47   :returning time-t)
  48
  49 (uffi:def-function ("localtime" c-localtime)
  50     ((time (* time-t)))
  51   :returning (* tm))
  52
  53 (uffi:def-type time-t :unsigned-long)
  54 (uffi:def-type tm-pointer (* tm))
  55
  56 (defun gettime ()
  57    "Returns the local time"
  58    (let* ((time (uffi:allocate-foreign-object time-t)))
  59      (declare (type time-t time))
  60      (c-time time)
  61      (let ((tm-ptr (the tm-pointer (c-localtime time))))
  62        (declare (type tm-pointer tm-ptr))
  63        (let ((time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
  64                                   (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
  65                                   (uffi:get-slot-value tm-ptr 'tm 'mday)
  66                                   (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
  67                                   (uffi:get-slot-value tm-ptr 'tm 'hour)
  68                                   (uffi:get-slot-value tm-ptr 'tm 'min)
  69                                   (uffi:get-slot-value tm-ptr 'tm 'sec)
  70                                   )))
  71          (uffi:free-foreign-object time)
  72          time-string))
  73      ))
  74
  75
  76
  77
  78 #+test-uffi
  79 (format t "~&~A" (gettime))
  80
  81