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.1 2002/03/09 19:55:33 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-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-routine ("time" c-time)
  46     ((time (* time-t)))
  47   :returning time-t)
  48
  49 (uffi:def-routine ("localtime" c-localtime)
  50     ((time (* time-t)))
  51   :returning (* tm))
  52
  53 (defun gettime ()
  54   "Returns the local time"
  55   (let* ((time (uffi:allocate-foreign-object time-t)))
  56     (c-time time)
  57     (let* ((tm-ptr (c-localtime time))
  58            (time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
  59                                 (1+ (uffi:get-slot-value tm-ptr 'mon 'tm))
  60                                 (uffi:get-slot-value tm-ptr 'mday 'tm)
  61                                 (+ 1900 (uffi:get-slot-value tm-ptr 'year 'tm))
  62                                 (uffi:get-slot-value tm-ptr 'hour 'tm)
  63                                 (uffi:get-slot-value tm-ptr 'min 'tm)
  64                                 (uffi:get-slot-value tm-ptr 'sec 'tm)
  65                                 )))
  66       (uffi:free-foreign-object time)
  67       time-string)
  68     ))
  69
  70 (format t "~&~A" (gettime))
  71
  72