[SCM] Lisaac compiler branch, stable, updated. lisaac-0.12-464-g6a18653
Mildred Ki'Lya
silkensedai at online.fr
Sat Sep 5 13:26:54 UTC 2009
The following commit has been merged in the stable branch:
commit 6a1865387c406fd59f4317902c4f247b25bb0408
Author: Mildred Ki'Lya <silkensedai at online.fr>
Date: Sat Sep 5 15:26:44 2009 +0200
Removed *~ files from repository
diff --git a/lib_os/unix/file_system/directory_unix.li~ b/lib_os/unix/file_system/directory_unix.li~
deleted file mode 100644
index 585c332..0000000
--- a/lib_os/unix/file_system/directory_unix.li~
+++ /dev/null
@@ -1,155 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name :=DIRECTORY_UNIX;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - bibliography:="http://IsaacOS.com";
-
- - author :="Benoit Sonntag (bsonntag at loria.fr)";
-
- - comment :="Directory management";
-
- - external :=
-`
-#include <dirent.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-`;
-
-Section Inherit
-
- + parent_entry_unix:Expanded ENTRY_UNIX;
-
- + parent_directory:Expanded DIRECTORY;
-
-Section Public
-
- - is_open:BOOLEAN <- ( list != NULL);
-
- //
- // Scanning
- //
-
- - open:BOOLEAN <-
- ( + p,n:NATIVE_ARRAY(CHARACTER);
- + dir,dirent:POINTER;
- + new_entry:ENTRY;
- + result:BOOLEAN;
- + i:INTEGER;
-
- (list = NULL).if {
- list := LINKED_LIST(ENTRY).create;
- } else {
- list.clear;
- };
- p := path.to_external;
- dir := `opendir(@p)`:POINTER;
- (dir != NULL).if {
- result := TRUE;
- {
-
- dirent := `readdir(@dir)`:POINTER;
- (dirent != NULL).if {
- n := `((struct dirent *)@dirent)->d_name`:NATIVE_ARRAY(CHARACTER);
- string_tmp.clear;
- i := 0;
- {n.item i = '\0'}.until_do {
- string_tmp.add_last (n.item i);
- i := i + 1;
- };
- (string_tmp !== ".".to_string).if {
- string_tmp.add_first '/';
- string_tmp.prepend path;
- reduce_path string_tmp;
- new_entry := get_entry string_tmp;
- (new_entry = NULL).if {
- result := FALSE;
- } else {
- (new_entry.path.count >= path.count).if {
- list.add_last new_entry;
- };
- };
- };
- };
- }.do_while {(dirent != NULL) && {result}};
- `closedir(@dir)`;
- };
- result
- );
-
-Section DIRECTORY
-
- - physical_get_entry new_path:ABSTRACT_STRING :ENTRY <-
- ( + pe:NATIVE_ARRAY(CHARACTER);
- + result:ENTRY;
-
- pe := new_path.to_external;
- `{ struct stat t`;
- (`stat(@pe,&t)`:INTEGER = 0).if {
- (`S_ISDIR(t.st_mode)`:INTEGER = 0).if {
- // File.
- result := FILE_UNIX.clone;
- } else {
- // Directory.
- result := DIRECTORY_UNIX.clone;
- };
- result.set_path new_path;
- alias.put result to (result.path);
- };
- `}`;
-
- result
- );
-
- - physical_make_directory new_path:ABSTRACT_STRING :BOOLEAN <-
- ( + pa:NATIVE_ARRAY(CHARACTER);
- pa := new_path.to_external;
- `mkdir(@pa,S_IRWXU)`:(INTEGER) = 0
- );
-
- - physical_make_file new_path:ABSTRACT_STRING :BOOLEAN <-
- ( + pa:NATIVE_ARRAY(CHARACTER);
- + stream:POINTER;
- + result:BOOLEAN;
-
- pa := new_path.to_external;
- stream := `fopen((char*)@pa,"w+b")`:POINTER;
- (stream != NULL).if {
- result := `fclose((FILE*)@stream)`:INTEGER = 0;
- };
- result
- );
-
- - physical_remove p:ABSTRACT_STRING :BOOLEAN <-
- ( + pa:NATIVE_ARRAY(CHARACTER);
- pa := p.to_external;
- `remove(@pa)`:(INTEGER) = 0
- );
-
- - physical_move old_path:ABSTRACT_STRING to new_path:ABSTRACT_STRING :BOOLEAN <-
- ( + old_p,new_p:NATIVE_ARRAY(CHARACTER);
- old_p := old_path.to_external;
- new_p := new_path.to_external;
- `rename(@old_p, at new_p)`:(INTEGER) = 0
- );
diff --git a/lib_os/unix/file_system/entry_unix.li~ b/lib_os/unix/file_system/entry_unix.li~
deleted file mode 100755
index e100640..0000000
--- a/lib_os/unix/file_system/entry_unix.li~
+++ /dev/null
@@ -1,150 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name := ENTRY_UNIX;
-
- - copyright := "2003-2008 Benoit Sonntag";
-
- - bibliography:= "http://IsaacOS.com";
-
- - author := "Benoit Sonntag (bsonntag at loria.fr)";
-
- - comment := "Entry ANSI C";
-
-Section Inherit
-
- + parent_entry:Expanded ENTRY;
-
-Section Public
-
- - access:UINTEGER_16 <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + result:UINTEGER_16;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- result := `t.st_mode`:UINTEGER_16 & 111_111_111b;
- `}`;
- result
- );
-
- - access_time:TIME <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + tt:POINTER;
- + result:TIME;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- tt := `localtime(&(t.st_atime))`:POINTER;
- result := to_time tt;
- `}`;
- result
- );
-
- - access_date:DATE <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + tt:POINTER;
- + result:DATE;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- tt := `localtime(&(t.st_atime))`:POINTER;
- result := to_date tt;
- `}`;
- result
- );
-
- - update_time:TIME <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + tt:POINTER;
- + result:TIME;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- tt := `localtime(&(t.st_mtime))`:POINTER;
- result := to_time tt;
- `}`;
- result
- );
-
- - update_date:DATE <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + tt:POINTER;
- + result:DATE;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- tt := `localtime(&(t.st_mtime))`:POINTER;
- result := to_date tt;
- `}`;
- result
- );
-
- - create_time:TIME <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + tt:POINTER;
- + result:TIME;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- tt := `localtime(&(t.st_ctime))`:POINTER;
- result := to_time tt;
- `}`;
- result
- );
-
- - create_date:DATE <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + tt:POINTER;
- + result:DATE;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- tt := `localtime(&(t.st_ctime))`:POINTER;
- result := to_date tt;
- `}`;
- result
- );
-
-Section Private
-
- //
- // Time / Date: Unix -> Lisaac
- //
-
- - to_date t:POINTER :DATE <-
- ( + result:DATE;
- + wd,md,m:UINTEGER_8;
- + y:UINTEGER_16;
-
- y := `((struct tm *)@t)->tm_year`:UINTEGER_16 + 1900;
- m := `((struct tm *)@t)->tm_mon` :UINTEGER_8 + 1;
- md := `((struct tm *)@t)->tm_mday`:UINTEGER_8;
- wd := `((struct tm *)@t)->tm_wday`:UINTEGER_8;
- (! wd.in_range 1 to 7).if { // Bug in UNIX ?
- wd := 1;
- };
- result := DATE.create (y,m,md,wd)
- );
-
- - to_time t:POINTER :TIME <-
- (
- TIME.create
- ((`((struct tm *)@t)->tm_hour`:UINTEGER_8),
- (`((struct tm *)@t)->tm_min` :UINTEGER_8),
- (`((struct tm *)@t)->tm_sec` :UINTEGER_8),
- 0)
- );
-
diff --git a/lib_os/unix/file_system/file_system.li~ b/lib_os/unix/file_system/file_system.li~
deleted file mode 100755
index f90ea8e..0000000
--- a/lib_os/unix/file_system/file_system.li~
+++ /dev/null
@@ -1,50 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name :=FILE_SYSTEM;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - comment :="File System manager for Unix.";
-
- - external := `#include <unistd.h>`; // For `getcwd'
-
-Section Inherit
-
- + parent_directory:DIRECTORY <-
- ( + cwd:NATIVE_ARRAY[CHARACTER];
- + result:DIRECTORY;
-
- DIRECTORY.string_tmp.clear;
- cwd := DIRECTORY.string_tmp.to_external;
- `getcwd(@cwd,255)`;
- DIRECTORY.string_tmp.from_external cwd;
-
- result ?= DIRECTORY_UNIX.physical_get_entry (DIRECTORY.string_tmp);
- DIRECTORY.alias.put result to (result.path);
- ? {result != NULL};
- parent_directory := result
- );
-
-
-
-
diff --git a/lib_os/unix/file_system/file_unix.li~ b/lib_os/unix/file_system/file_unix.li~
deleted file mode 100755
index dc9e9c7..0000000
--- a/lib_os/unix/file_system/file_unix.li~
+++ /dev/null
@@ -1,120 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name := FILE_UNIX;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - comment := "File management";
-
-Section Inherit
-
- + parent_entry_unix:Expanded ENTRY_UNIX;
-
- + parent_file:Expanded STD_FILE;
-
-Section Private
-
- + stream:POINTER; // Unix file pointer (FILE *).
-
-Section Public
-
- //
- // Physical implementation.
- //
-
- - is_open:BOOLEAN <- stream != NULL;
-
- - size:UINTEGER_32 <-
- ( + pe:NATIVE_ARRAY[CHARACTER];
- + result:UINTEGER_32;
- pe := path.to_external;
- `{ struct stat t; stat(@pe,&t)`;
- result := `t.st_size`:UINTEGER_32;
- `}`;
- result
- );
-
- - cursor:UINTEGER_32 <-
- ( + str:POINTER;
- str := stream;
- `ftell((FILE *)@str)`:UINTEGER_32
- );
-
- - set_cursor n:UINTEGER_32 <-
- [
- ...
- -? {stream != NULL};
- -? {n <= size};
- ]
- ( + str:POINTER;
- str := stream;
- `fseek((FILE*)(@str), at n,SEEK_SET)`;
- );
-
- - open:BOOLEAN <-
- [
- -? {stream = NULL};
- ]
- ( + pa:NATIVE_ARRAY[CHARACTER];
-
- pa := path.to_external;
- stream := `fopen((char*)@pa,"r+b")`:(POINTER);
- stream != NULL
- );
-
- - open_read_only:BOOLEAN <-
- ( + pa:NATIVE_ARRAY[CHARACTER];
- pa := path.to_external;
- stream := `fopen((char*)@path_pointer,"rb")`:(POINTER);
- stream != NULL
- );
-
- - close <-
- [
- -? {stream != NULL};
- ]
- ( + str:POINTER;
-
- str := stream;
- `fclose((FILE*)(@str))`;
- stream := NULL;
- );
-
-Section STD_FILE
-
- - physical_read buf:NATIVE_ARRAY[UINTEGER_8] size s:INTEGER :INTEGER <-
- // return size read or 0 if end of input (-1 on error => exception ?)
- ( + str:POINTER;
- str := stream;
- `fread((void *)(@buf),(size_t)(1), (size_t)(@s),(FILE*)(@str))`:(INTEGER)
- );
-
- - physical_write buf:NATIVE_ARRAY[UINTEGER_8] size s:INTEGER :INTEGER <-
- // return size read or 0 if end of input (-1 on error => exception ?)
- ( + str:POINTER;
- str := stream;
- `fwrite((void *)(@buf),(size_t)(1), (size_t)(@s),(FILE*)(@str))`:(INTEGER)
- );
-
-
-
diff --git a/lib_os/unix/system/system.li~ b/lib_os/unix/system/system.li~
deleted file mode 100755
index a1283f2..0000000
--- a/lib_os/unix/system/system.li~
+++ /dev/null
@@ -1,126 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name := SYSTEM;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - comment := "Generic System Object (methods).";
-
- - external := `#include <time.h>`;
-
-Section Public
-
- - is_ansi:BOOLEAN := TRUE;
-
- - exit code:INTEGER <- `exit(@code)`;
-
- - putb value:UINTEGER_8 to port:UINTEGER_16 <-
- // Write in port
- (
- `{ unsigned short val;
- val = @value;
- asm
- (
- "movw %0,%%dx \n\
- movw %1,%%ax \n\
- outb %%al,%%dx "
- : /* No output */
- :"r"(@port), "r"(val)
- :"%ax","%dx"
- );
- }`;
- );
-
- - itemb port:UINTEGER_16 :UINTEGER_8 <-
- // Read in port
- ( + result:UINTEGER_8;
- `{ unsigned short res;
- asm
- (
- "movw %1,%%dx \n\
- inb %%dx,%%al \n\
- movw %%ax,%0 "
- :"=r"(res)
- :"r"(@port)
- :"%ax","%dx"
- )`;
- result := `res`:UINTEGER_8;
- `}`;
- result
- );
-
- - get_universal_time:UINTEGER_64 <-
- (
- `(unsigned long long)time(NULL)`:UINTEGER_64
- );
-
- // Memory Management
-
- - memory:MEMORY := MEMORY;
-
- - get_begin_memory:POINTER;
-
- - get_memory_capacity:POINTER <-
- ( + cap:POINTER;
- + mem,new_mem:POINTER;
- cap := 32.mb;
- {
- cap := cap * 2;
- mem := new_mem;
- new_mem := `realloc(@mem,(unsigned int)@cap)`:POINTER;
- /*(mem != NULL).if {
- `free(@mem)`;
- };*/
- }.do_until {(new_mem = NULL) || {cap = `(void *)(2048LU << 20)`:POINTER}}; // BSBS: BUG COMPILO 0.13
- (new_mem = NULL).if {
- cap := cap / 2;
- };
- get_begin_memory := mem;
- //
- cap
- );
-
-Section SYSTEM,MEMORY
- /*
- - realloc_c (beg:UINTEGER_32,nb:INTEGER) :UINTEGER_32 <-
- ( + result:UINTEGER_32;
- result := `(unsigned long)realloc((void *)@beg, at nb+15)`:UINTEGER_32;
- ((beg != 0) && {result != beg}).if {
- MEMORY.print_nbx beg;
- '\n'.print;
- MEMORY.print_nbx result;
- '\n'.print;
- exit 1;
- };
- ? {(beg != 0) ->> {beg = result}};
- ? {result != 0};
- result
- );
- */
-Section ISAAC
-
- - make <-
- // Isaac compatibility.
- (
- // Nothing.
- );
\ No newline at end of file
diff --git a/lib_os/unix/system/system_io.li~ b/lib_os/unix/system/system_io.li~
deleted file mode 100755
index 2c31062..0000000
--- a/lib_os/unix/system/system_io.li~
+++ /dev/null
@@ -1,68 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name := SYSTEM_IO;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - comment := "Lower level for Input / Output";
-
- - external := `
-#include <stdio.h>
-#include <stdlib.h>
-
-// Hardware 'print_char'
-void print_char(char car)
-{
- fputc(car,stdout);
-}
-
-// Hardware 'exit'
-int die_with_code(int code)
-{
- exit(code);
-}
-
-`;
-
-Section Inherit
-
- - parent_object:OBJECT := OBJECT;
-
-Section Public
-
- - print_char byte:CHARACTER <-
- // Low level buffered output.
- (
- `fputc((int)@byte,stdout)`;
- );
-
- - print_error_char byte:CHARACTER <-
- // Low level buffered error output.
- (
- `fputc((int)@byte,stderr)`;
- );
-
- - get_char :CHARACTER <- `fgetc(stdin)`:(CHARACTER);
-
- - eof:CHARACTER <- `EOF`:CHARACTER;
-
\ No newline at end of file
diff --git a/lib_os/unix/video/mouse.li~ b/lib_os/unix/video/mouse.li~
deleted file mode 100755
index c766adc..0000000
--- a/lib_os/unix/video/mouse.li~
+++ /dev/null
@@ -1,243 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name := MOUSE;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - comment := "X11 - Mouse driver";
-
-Section Inherit
-
- + parent_input:Expanded INPUT;
-
- + parent_window:Expanded AREA; // MASK
-
-Section Public
-
- - set (x,y:INTEGER) with (left_new,right_new:BOOLEAN) <-
- ( + tmp:UINTEGER_8;
- + x_new, y_new:INTEGER;
-
- y_new := y.max y_minimum.min y_maximum;
- x_new := x.max x_minimum.min x_maximum;
-
- tmp:=(p_end+1)&003h;
- buffer_event.item p_end.make (x_new,y_new) button (left_new,right_new);
-
- (((tmp+2)&3)!=p_beg).if {
- p_end:=tmp;
- };
-
- get_event;
-
- // Update status.
- x_current:=x_new;
- y_current:=y_new;
- right :=right_new;
- left :=left_new;
- );
-
-Section Public
-
- + x_minimum:INTEGER;
- - x_maximum:INTEGER <- VIDEO.x_max;
-
- + y_minimum:INTEGER;
- - y_maximum:INTEGER <- VIDEO.y_max;
-
- + x_current:INTEGER;
- + y_current:INTEGER;
-
- + right:BOOLEAN;
- + left :BOOLEAN;
-
-Section Private
-
- + buffer_event:FAST_ARRAY[EVENT_MOUSE];
- - p_beg:UINTEGER_8; // Pointer on the buffer (beginning)
- - p_end:UINTEGER_8; // Pointer on the buffer (end)
-
-Section Public
-
- //
- // Creation / Initialisation.
- //
-
- - make <-
- ( + new_event:EVENT_MOUSE;
-
- is_actif := TRUE;
-
- //
- // Software configuration.
- //
- buffer_event := FAST_ARRAY[EVENT_MOUSE].create 4;
- 0.to 3 do { j:INTEGER;
- new_event := EVENT_MOUSE.clone;
- buffer_event.put new_event to j;
- (j != 0).if {
- new_event.set_prev (buffer_event.item (j-1));
- };
- };
- buffer_event.first.set_prev new_event;
-
- // MASK
- mask := FAST_ARRAY[UINTEGER_16].create 16;
- make (DESK.physical_screen) from (x_current,y_current) size (16,16);
- );
-
- - get_event <-
- ( + p:INTEGER;
- + evt:EVENT_MOUSE;
-
- p := p_beg;
- (p != p_end).if {
- ((x_current != x_window) || {y_current != y_window}).if {
- set_position (x_current,y_current);
- };
- { p != p_end }.while_do {
- evt := buffer_event.item p;
- (list_client.lower).to (list_client.upper) do { j:INTEGER;
- list_client.item j.receive (buffer_event.item p);
- };
- p := (p + 1) & 03h;
- };
- };
- );
-
- - acknowledge <-
- (
- p_beg := (p_beg+1) & 03h;
- );
-
- //
- // Display.
- //
-
- // BSBS: A refaire avec une bitmap en dehors contenant le dessin avec une couleur de mask!!
- // Plus simple, plus puissant, plus rapide !
-
- + mask:FAST_ARRAY[UINTEGER_16];
-
- - pixel_hard (x,y:INTEGER) color col:UINTEGER_32 <-
- ( + m:UINTEGER_16;
- ? {x<16};
- ? {y<16};
-
- m:=mask.item y;
- m:=m | (1<<x);
- mask.put m to y;
-
- parent_window.pixel_hard (x,y) color col;
- );
-
- - line_h_hard (x0,y0:INTEGER) until x1:INTEGER color col:UINTEGER_32 <-
- ( + m:UINTEGER_16;
- ? {x0<16};
- ? {y0<16};
- ? {x1<16};
-
- m:=mask.item y0;
- x0.to x1 do { xx:INTEGER;
- m:=m | (1<<xx);
- };
-
- mask.put m to y0;
- parent_window.line_h_hard (x0,y0) until x1 color col;
- );
-
- - slave_pixel_hard (x,y:INTEGER) color col:UINTEGER_32 <-
- ( + m:UINTEGER_16;
-
- m:=mask.item y;
- ((m & (1<<x))=0).if {
- parent_window.pixel_hard (x,y) color col;
- };
- );
-
- - slave_line_h_hard (x1,y:INTEGER) until x2:INTEGER color col:UINTEGER_32 <-
- ( + m:UINTEGER_16;
-
- m:=mask.item y;
- x1.to x2 do { xx:INTEGER;
- ((m & (1<<xx))=0).if {
- parent_window.pixel_hard (xx,y) color col;
- };
- };
- );
-
- - slave_line_h_hard (x1,y:INTEGER) until x2:INTEGER image line:ABSTRACT_BMP_LINE offset ofs:INTEGER <-
- ( + m:UINTEGER_16;
- + col:UINTEGER_32;
- + ofs_img:INTEGER;
- ofs_img := ofs;
- m:=mask.item y;
- x1.to x2 do { xx:INTEGER;
- ((m & (1<<xx))=0).if {
- col := line.get_color ofs_img;
- parent_window.pixel_hard (xx,y) color col;
- };
- ofs_img := ofs_img + 1;
- };
- );
-
- - draw (x0,y0:INTEGER) to (x1,y1:INTEGER) <-
- (
- clipping (x0,y0) to (x1,y1);
-
- color white;
- poly_move_to (1,1);
- poly_line_to (9,9);
- poly_line_to (6,9);
- poly_line_to (8,14);
- poly_line_to (5,14);
- poly_line_to (5,9);
- poly_line_to (1,9);
- poly_move_to (1,1);
- poly_trace;
-
- color red;
- line_v (0,0) until 10;
- line_h (1,10) until 4;
- line_v (4,11) until 15;
- line_h (5,15) until 9;
- line (9,15) to (7,10);
- line_h (7,10) until 10;
- line (1,0) to (10,9);
- );
-
- - get_object (x,y:INTEGER) :AREA <-
- (
- NULL
- );
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib_os/unix/video/timer.li~ b/lib_os/unix/video/timer.li~
deleted file mode 100755
index ba238ce..0000000
--- a/lib_os/unix/video/timer.li~
+++ /dev/null
@@ -1,157 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name := TIMER;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - comment :="Unix - Timer management.";
-
- - version := 1;
-
- - date :="2003/04";
-
- - external :=
-`
-#include <signal.h>
-#define __BEGIN_INTERRUPT__
-#define __END_INTERRUPT__
-XEvent timer_ev;
-`;
-
-Section Inherit
-
- + parent_input:Expanded INPUT;
-
-Section Private
-
- - timer_count:UINTEGER_32;
-
- - buffer_event:FAST_ARRAY[EVENT_TIMER];
-
- - p_beg:UINTEGER_8; // Pointer on the buffer (beginning)
-
- - p_end:UINTEGER_8; // Pointer on the buffer (end)
-
-Section Interrupt
-
- - timer_interrupt <-
- ( + tmp:UINTEGER_8;
-
- timer_count := timer_count + 1;
-
- tmp:=(p_end+1)&003h;
- buffer_event.item p_end.make timer_count;
- (((tmp+2)&3)!=p_beg).if {
- p_end:=tmp;
- };
- // ((timer_count % 20)=0).if {
- // CLOCK.rtc;
- // };
-
- (`is_sleep`:INTEGER = 1).if {
- `timer_ev.type = ClientMessage`;
- `timer_ev.xclient.format = 32`;
- (`XSendEvent(display,window,0,ClientMessage,&timer_ev)`:INTEGER != 0).if {
- `XFlush(display)`;
- };
- };
- `ualarm(50000,0)`;
- );
-
-Section Public
-
- - make <-
- ( + hdle:POINTER;
- + new_event:EVENT_TIMER;
-
- is_actif := TRUE;
- //
- // Software configuration.
- //
- buffer_event := FAST_ARRAY[EVENT_TIMER].create 4;
- 0.to 3 do { j:INTEGER;
- new_event := EVENT_TIMER.clone;
- buffer_event.put new_event to j;
- (j != 0).if {
- new_event.set_prev (buffer_event.item (j-1));
- };
- };
- buffer_event.first.set_prev new_event;
-
- hdle := timer_interrupt;
- `signal(SIGALRM, at hdle)`;
- `ualarm(500000,0)`;
- );
-
- - acknowledge <-
- (
- p_beg := (p_beg+1) & 03h;
- );
-
- - get_event <-
- ( + p:INTEGER;
- + evt:EVENT_TIMER;
-
- p := p_beg;
- { p != p_end }.while_do {
- evt := buffer_event.item p;
- (list_client.lower).to (list_client.upper) do { j:INTEGER;
- list_client.item j.receive (buffer_event.item p);
- };
- p := (p + 1) & 03h;
- };
- );
-
-
-/*
-//Other solution :
-void catcher( int sig ) {
-
- time_count ++;
-}
-
-int main( int argc, char *argv[] ) {
-
- int old_time;
-
- struct itimerval value;
-
- signal(SIGALRM,catcher);
-
- value.it_interval.tv_sec = 1;
- value.it_interval.tv_usec = 0;
- value.it_value.tv_sec = 1;
- value.it_value.tv_usec = 0;
-
- setitimer(ITIMER_REAL, &value, NULL);
-
- while (1) {
- if (old_time != time_count) {
- printf("Time %ld\n",time_count);
- old_time = time_count;
- };
- };
-
- return(0);
-}
-*/
\ No newline at end of file
diff --git a/lib_os/unix/video/video.li~ b/lib_os/unix/video/video.li~
deleted file mode 100644
index 6b4a452..0000000
--- a/lib_os/unix/video/video.li~
+++ /dev/null
@@ -1,233 +0,0 @@
-///////////////////////////////////////////////////////////////////////////////
-// Lisaac OS Library //
-// //
-// LSIIT - ULP - CNRS - INRIA - FRANCE //
-// //
-// This program is free software: you can redistribute it and/or modify //
-// it under the terms of the GNU General Public License as published by //
-// the Free Software Foundation, either version 3 of the License, or //
-// (at your option) any later version. //
-// //
-// This program is distributed in the hope that it will be useful, //
-// but WITHOUT ANY WARRANTY; without even the implied warranty of //
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
-// GNU General Public License for more details. //
-// //
-// You should have received a copy of the GNU General Public License //
-// along with this program. If not, see <http://www.gnu.org/licenses/>. //
-// //
-// http://isaacproject.u-strasbg.fr/ //
-///////////////////////////////////////////////////////////////////////////////
-Section Header
-
- + name := VIDEO;
-
- - copyright := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
-
- - comment := "X11 Driver video - Xlib -";
-/*
- - lip <-
- (
- add_lib "-lX11";
- );
- */
- - external :=
-`
-#include <X11/Xlib.h>
-Display *display;
-Window window;
-GC gc;
-Screen *screen;
-XImage *ximage=NULL;
-`;
-
-Section Inherit
-
- + parent_bitmap:Expanded BITMAP(PIXEL_24);
-
-Section Public //VIDEO
-
- - line_tmp:ABSTRACT_BMP_LINE;
-
-Section Public
-
- - message str:ABSTRACT_STRING <-
- (
- "Message : ".print; str.print; '\n'.print;
- );
-
- - is_active:BOOLEAN;
-
- - planes:UINTEGER_32;
-
- - resize (w,h:INTEGER) <-
- (
- width := w;
- height := h;
- clipping_off;
- );
-
- - make (w,h:INTEGER) <-
- ( + data:NATIVE_ARRAY(UINTEGER_8);
- + w_max:INTEGER;
-
- // Init BITMAP:
- width := w;
- height := h;
-
- // Creation Server X:
- `display = XOpenDisplay(NULL)`;
- // Screen Default:
- `screen = ScreenOfDisplay(display,DefaultScreen(display))`;
- // Init Graphic context:
- `gc = DefaultGC(display,DefaultScreen(display))`;
- // Creation Window:
- `window = XCreateSimpleWindow(display,RootWindow(display,DefaultScreen(display)), 0,0, at w, at h,2,0,0)`;
-
- // Event manager:
- //XSelectInput(display,window,ExposureMask);
-
- // Title window:
- `XStoreName(display,window,"X-Isaac")`;
-
- // Display Window:
- `XMapWindow(display,window)`;
-
- planes := `PlanesOfScreen(screen)`:UINTEGER_32;
- "Video mode: ".print;
- planes.print; "bits\n".print;
-
- w_max := `WidthOfScreen(screen)`:INTEGER;
-
- planes
- .when 15 then {
- line_tmp := BMP_LINE(PIXEL_15).create w_max;
- data := line_tmp.get_storage;
- `ximage = XCreateImage(display,None,15,ZPixmap,0,(char *)@data, at w_max,1,16,0)`;
- }
- .when 16 then {
- line_tmp := BMP_LINE(PIXEL_16).create w_max;
- data := line_tmp.get_storage;
- `ximage = XCreateImage(display,None,16,ZPixmap,0,(char *)@data, at w_max,1,16,0)`;
- }
- .when 24 then {
- line_tmp := BMP_LINE(PIXEL_32).create w_max;
- data := line_tmp.get_storage;
- `ximage = XCreateImage(display,None,24,ZPixmap,0,(char *)@data, at w_max,1,32,0)`;
- }
- .when 32 then {
- line_tmp := BMP_LINE(PIXEL_32).create w_max;
- data := line_tmp.get_storage;
- `ximage = XCreateImage(display,None,32,ZPixmap,0,(char *)@data, at w_max,1,32,0)`;
- };
-
- is_active := TRUE;
- );
-
- - auto_make <-
- (
- make (800,600);
- );
-
- - close <-
- (
- ? {is_active};
- // Remove Window:
- //`XUnmap(display,window)`;
- is_active := FALSE;
- ? {! is_active};
- );
-
- //
- // Redefine Low level Bitmap.
- //
-
-Section Public
-
- - pixel_hard (x,y:INTEGER) color col:UINTEGER_32 <-
- ( + real_col:UINTEGER_32;
- + m:UINTEGER_8;
-
- VIDEO.planes
- .when 15 then {
- real_col := PIXEL_15.get_raw col;
- }
- .when 16 then {
- real_col := PIXEL_16.get_raw col;
- }
- .when 24 then {
- real_col := PIXEL_24.get_raw col;
- }
- .when 32 then {
- real_col := PIXEL_32.get_raw col;
- };
- m := mode;
- `XSetForeground(display,gc,(int)@real_col)`;
- `XSetFunction(display,gc,(int)@m)`;
- `XDrawPoint(display,window,gc, at x, at y)`;
- );
-
- - line_h_hard (x,y:INTEGER) until x1:INTEGER color col:UINTEGER_32 <-
- ( + real_col:UINTEGER_32;
- + m:UINTEGER_8;
-
- VIDEO.planes
- .when 15 then {
- real_col := PIXEL_15.get_raw col;
- }
- .when 16 then {
- real_col := PIXEL_16.get_raw col;
- }
- .when 24 then {
- real_col := PIXEL_24.get_raw col;
- }
- .when 32 then {
- real_col := PIXEL_32.get_raw col;
- };
- m := mode;
- `XSetForeground(display,gc,(int)@real_col)`;
- `XSetFunction(display,gc,(int)@m)`;
- `XDrawLine(display,window,gc, at x, at y, at x1, at y)`;
- );
-
- - line_h_hard (x,y:INTEGER) until x1:INTEGER
- image line:ABSTRACT_BMP_LINE offset ofs:INTEGER <-
- ( + len:INTEGER;
-
- len := x1 - x;
- VIDEO.line_tmp.put line offset ofs from 0 to len;
- `XPutImage(display,window,gc, ximage, 0, 0, @x, @y, @len+1, 1)`;
- );
-
- - get_pixel_hard (x,y:INTEGER) :PIXEL <-
- (
- not_yet_implemented;
- );
-
- /* A voir pour bloquer la size minimum
-
-// pointer to the size hints structure.
-XSizeHints* win_size_hints = XAllocSizeHints();
-if (!win_size_hints) {
- fprintf(stderr, "XAllocSizeHints - out of memory\n");
- exit(1);
-}
-
-// initialize the structure appropriately.
-// first, specify which size hints we want to fill in.
-// in our case - setting the minimal size as well as the initial size.
-win_size_hints->flags = PSize | PMinSize;
-// next, specify the desired limits.
-// in our case - make the window's size at least 300x200 pixels.
-// and make its initial size 400x250.
-win_size_hints->min_width = 300;
-win_size_hints->min_height = 200;
-win_size_hints->base_width = 400;
-win_size_hints->base_height = 250;
-
-// pass the size hints to the window manager.
-XSetWMNormalHints(display, win, win_size_hints);
-
-// finally, we can free the size hints structure.
-XFree(win_size_hints);
-*/
\ No newline at end of file
--
Lisaac compiler
More information about the Lisaac-commits
mailing list