Newbie questions about Pliant

Newbie questions about Pliant

wrapping ggi library

problems wrapping the ggi library
Message posted by maybe Boris on 2001/11/20 03:58:15
I am going to paste in the ggi.pli file that I have. 
running pliant on it gives 'exception 11' and I don't know what it means. 
If you can help me, or even do some more work on wrapping ggi, thanks :)

Also, is it possible to do a typedef in pliant ?   I want to refer 
to uInt32 as ggi_graphtype, for example.  

=========================================================================
#ggi.pli
#BRZ: wrapper to the GGI library in c

# need this to allow casting to and from c types
module "/pliant/language/unsafe.pli"

type ggi_color
  packed
  field uInt16 r g b a

type ggi_coord
  packed
  field Int16 x y 

type ggi_mode
  packed
  field Int32 frames
  field ggi_coord visible
  field ggi_coord virt
  field ggi_coord size
  field uInt32 graphtype  # uint32 = graphtype
  field ggi_coord dpp

################################################################################
### REWRITING MACROS ###
### CONSTANTS (define macros) ###

gvar Int16 GGI_AUTO       := 0
gvar uInt GGIFLAG_ASYNC   := 0001h
gvar uInt GT_DEPTH_SHIFT  := 0
gvar uInt GT_SCHEME_SHIFT := 24
gvar uInt GT_DEPTH_MASK   := FFh .*. 2^GT_DEPTH_SHIFT
gvar uInt GT_SCHEME_MASK  := FFh .*. 2^GT_SCHEME_SHIFT
gvar uInt GT_PALETTE      := 4h  .*. 2^GT_SCHEME_SHIFT

gvar Int GII_KT_SPEC := E0h
gvar Int GII_KT_MOD  := E3h

function GII_KTYP x -> y
  arg Int x y
  y := x \ 2^8

function GII_KEY typ val -> retval 
  arg Int typ val retval
  retval := typ .*. 2^8;
  retval := retval .or. val;

gvar Int GIIK_VOID := ( GII_KEY GII_KT_SPEC  0 )


function GT_DEPTH x -> y
  arg uInt32 x y;
  y := x .and. GT_DEPTH_MASK 
  y := y \ 2^GT_DEPTH_SHIFT

function GT_SCHEME x -> y    
  arg uInt32 x y
  y := x .and. GT_SCHEME_MASK


################################################################################
# FUNCTION DEFINITIONS

# int  ggiInit(void);
function ggiInit -> retval
  arg Int retval
  external "libggi.so" "ggiInit"

# int  ggiExit(void);
function ggiExit -> retval
  arg Int retval
  external "libggi.so" "ggiExit"

# ggi_visual_t ggiOpen(const char *display,...);
function ggiOpen display -> vis
  arg_r CStr display;
  arg Address vis;
  external "libggi.so" "ggiOpen"

# int          ggiClose(ggi_visual_t vis);
function ggiClose vis -> retval
  arg Address vis
  arg Int retval 
  external "libggi.so" "ggiClose"

# int        ggiSetFlags(ggi_visual_t vis,ggi_flags flags);
function ggiSetFlags vis flags -> retval 
  arg Address vis;
  arg uInt flags;
  external "libggi.so" "ggiSetFlags"

# ggi_flags  ggiGetFlags(ggi_visual_t vis);
function ggiGetFlags vis -> flags 
  arg Address vis;
  arg uInt flags;
  external "libggi.so" "ggiGetFlags"

# int ggiSetMode(ggi_visual_t visual,ggi_mode *tm);
function ggiSetMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiSetMode"

# int ggiGetMode(ggi_visual_t visual,ggi_mode *tm);
function ggiGetMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiGetMode"

# int ggiCheckMode(ggi_visual_t visual,ggi_mode *tm);
function ggiCheckMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiCheckMode"

# int ggiFlush(ggi_visual_t vis);
function ggiFlush vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiFlush"

# int ggiSetGCForeground(ggi_visual_t vis,ggi_pixel  color);
function ggiSetGCForeground vis color -> retval
  arg Address vis
  arg uInt32 color
  arg Int retval;
  external "libggi.so" "ggiSetGCForeground"

# int ggiGetGCForeground(ggi_visual_t vis,ggi_pixel *color);
function ggiGetGCForeground vis color -> retval
  arg Address vis
  arg Address color
  arg Int retval;
  external "libggi.so" "ggiGetGCForeground"

# int ggiSetGCBackground(ggi_visual_t vis,ggi_pixel  color);
funcion ggiSetGCBackground vis color -> retval
  arg Address vis
  arg uInt32 color
  external "libggi.so" "ggiSetGCBackground"

# int ggiGetGCBackground(ggi_visual_t vis,ggi_pixel *color);
function ggiGetGCBackground vis color -> retval
  arg Address vis
  arg Address color
  arg Int retval
  external "libggi.so" "ggiGetGCBackground"

# int ggiSetGCClipping(ggi_visual_t vis,int  left,int  top,int  right,int  bottom);
function ggiSetGCClipping vis left top right bottom -> retval
  arg Address vis
  arg Int left top right bottom
  arg Int retval
  external "libggi.so" "ggiSetGCClipping"

# int ggiGetGCClipping(ggi_visual_t vis,int *left,int *top,int *right,int *bottom);
function ggiGetGCClipping vis left tio right botom -> retval
  arg Address vis
  arg Address left top right bottom
  arg Int retval
  external "libggi.so" "ggiGetGCClipping"

# ggi_pixel ggiMapColor(ggi_visual_t vis,ggi_color *col);
function ggiMapColor vis color -> pixel
  arg Address vis
  arg Address color 
  arg uInt32 pixel
  external "libggi.so" "ggiMapColor"

#int ggiGetPalette(ggi_visual_t vis,int s,int len,ggi_color *cmap);
function ggiGetPalette vis s len cmap -> retval
  arg Address 
  arg Int s len
  arg Address cmap
  arg Int retval
  external "libggi.so" "ggiGetPalette"

#int ggiSetPalette(ggi_visual_t vis,int s,int len,ggi_color *cmap);
function ggiSetPalette vis s len cmap -> retval
  arg Address 
  arg Int s len
  arg Address cmap
  arg Int retval
  external "libggi.so" "ggiSetPalette"

#int ggiSetColorfulPalette(ggi_visual_t vis);
function ggiSetColorfulPalette vis -> retval 
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiSetColorfulPalette"

#int ggiSetOrigin(ggi_visual_t vis,int x,int y);
function ggiSetOrigin vis x y -> retval
  arg Address vis
  arg Int x y retval
  external "libggi.so" "ggiSetOrigin"

#int ggiGetOrigin(ggi_visual_t vis,int *x,int *y);
function ggiGetOrigin vis x y -> retval
  arg Address vis
  arg Address x y 
  arg Int retval
  external "libggi.so" "ggiGetOrigin"

#int ggiFillscreen(ggi_visual_t vis);
function ggiFillscreen vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiFillscreen"

#int ggiDrawPixel(ggi_visual_t vis,int x,int y);
function ggiDrawPixel vis x y -> retval
  arg Address vis
  arg Int x y 
  arg Int retval
  external "libggi.so" "ggiDrawPixel"
  
#int ggiKbhit(ggi_visual_t vis);
function ggiKbhit vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiKbhit"

#int ggiGetc(ggi_visual_t vis);
function ggiGetc vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiGetc"


########################## EXPORT ##############################################
export GII_KTYP 
export GII_KEY 
export GT_DEPTH 
export GT_SCHEME 
export ggiInit 
export ggiExit 
export ggiOpen 
export display 
export ggiClose 
export ggiSetFlags 
export ggiGetFlags 
export ggiSetMode 
export ggiGetMode
export ggiCheckMode 
export ggiFlush 
export ggiSetGCForeground 
export ggiGetGCForeground
export ggiGetGCBackground 
export ggiSetGCClipping 
export ggiGetGCClipping 
export ggiMapColor 
export ggiGetPalette 
export ggiSetPalette
export ggiSetColorfulPalette 
export ggiSetOrigin 
export ggiGetOrigin 
export ggiFillscreen 
export ggiDrawPixel 
export ggiKbhit 
export ggiGetc 

#end ggi.pli
=============================================


This it the output of debug level 2
===

exception 11
----------------------------------------------------------------
processor stack content is:
. terminate_arguments (Function Int) +468
external +124
active_type_Meta +110
. compile_step4 (Expression Address Int) +274
active_type_Ident +210
. compile_step4 (Expression Address Int) +274
. compile_step3 (Expression) +18
. compile_step2 (Expression) +64
. compile (Expression) +17
  file:ggi.pli (internals) 89 3
{} +43
active_type_Meta +110
. compile_step4 (Expression Address Int) +274
active_type_Ident +210
. compile_step4 (Expression Address Int) +274
. compile_step3 (Expression) +18
. compile_step2 (Expression) +64
. compile (Expression) +17
  file:ggi.pli (internals) 87 1
kernel_function +1264
function +13
active_type_Meta +110
. compile_step4 (Expression Address Int) +274
active_type_Ident +210
. compile_step4 (Expression Address Int) +274
. compile_step3 (Expression) +18
. compile_step2 (Expression) +64
. compile (Expression) +17
  file:ggi.pli (internals) 86 1
{} +43
active_type_Meta +110
. compile_step4 (Expression Address Int) +274
active_type_Ident +210
. compile_step4 (Expression Address Int) +274
. compile_step3 (Expression) +18
. compile_step2 (Expression) +64
. compile (Expression) +17
  file:ggi.pli (internals) 86 1
. execute (Expression) +21
  file:ggi.pli (internals) 86 1
. execute (ParserContext) +40
parser_filter_execute +330
pliant internal parse_one_token function (ParserContext) +468
compile_text (List Module) +256
pliant_load_module (Str Module Int Module) +944
???
???




I didn't try running the driver program, because it fails the module loading step. 
#######################################
#tryggi1.pli
#BRZ: test the ggi.pli wrapper
module "/pliant/borisreitman/ggi.pli"

gvar Address vis;

function waitabit
  var Int key

  ggiFlush vis
  var Bool done := false

  while not done
    key := ggiGetc vis
    done := (key = GIIK_VOID) or (GII_KTYP:key = GII_KT_MOD);

  if ((key = 'q') or (key = 'Q')) # /* Q pressed */
    ggiClose vis
    ggiExit
    exit 0
#waitabit

gvar uInt32 white;
gvar uInt32 black;

function main
  var repeat;
  var x y;
  uInt32  type;
 
  var ggi_color pal;
  pal size := 256;

  var Int depth:=0;
  var Int doclip:=0;
  var Int sx,sy,vx,vy;
  var ggi_color tmp_color;
  var Address memvis;

  #This buffer will hold data for the Get/Put functions.
  var Array:Int8 put_buf
  put_buf size := 64*1024

  # set-up the mode
  var ggi_mode mode;
  mode:frames := 1           
  # default size
  # TODO: is there a way to assign in list-context, like in C or Perl
  mode:visible x := GGI_AUTO
  mode:visible y := GGI_AUTO
  mode:virt    x := GGI_AUTO
  mode:virt    y := GGI_AUTO

  # size in mm -- don't care
  mode:size    x := 0
  mode:size    y := 0
  mode:graphtype := GT_AUTO  # mode 
  # font size ?
  mode:dpp     x := GGI_AUTO
  mode:dpp     y := GGI_AUTO

  if ggiInit <> 0
    console "unable to initialize LibGGI, exiting.\n"
    exit

  vis := ggiOpen

  ggiSetFlags vis GGIFLAG_ASYNC

  #Is the mode possible ? If not, a better one will be * suggested. 
  ggiCheckMode vis addressof:mode
  ggiSetMode   vis addressof:mode   # now try it. it *should* work! 
  
  #Now we read back the set mode, as it might have been autoselected or changed.
  type=mode.graphtype;
  vx:=mode:virt:x;    vy:=mode:virt:y;
  sx:=mode:visible:x; sy:=mode:visible:y;
  depth=GT_DEPTH mode:graphtype
   
  if GT_SCHEME:mode.graphtype = GT_PALETTE  
    ggiSetColorfulPalette vis
    ggiGetPalette vis 0 (1 .*. 2^depth) pal;
  
  # /* Find the colors "white" and "black".  */
  tmp_color.r:=FFFFh; 
  tmp_color.g:=FFFFh;
  tmp_color.b:=FFFFh;
  
  white := ggiMapColor vis addressof:tmp_color

  tmp_color.r:=0h; 
  tmp_color.g:=0h;
  tmp_color.b:=0h;
  black      := ggiMapColor vis address:tmp_color

  ggiSetFlags vis GGIFLAG_ASYNC

  for repeat 0 10000
    ggiSetGCForeground vis  black # clear screen
    ggiFillscreen vis
    ggiSetGCForeground vis  white #  set white-on-black
    ggiSetGCBackground vis  black

    for (var Int x) 0 300
      y := x;
      ggiDrawPixel vis (x+repeat % 100) (y+repeat % 100);

    ggiFlush vis;
  #for    

  waitabit
  ggiClose vis
  ggiExit


======= this is the test code




Message posted by maybe Patrice Ossona de Mendez on 2001/11/20 08:26:59
If I well understand the compiler error (which should be a bit less obscure!),
the problem is that you forgot to define one argument in function
ggiSetFlags: retval!

Remark: it is useless to end a line with ";" : this is an operator which
is only used to separate instructions on a same line (somehow the same as
"," in C)
Message posted by maybe Patrice Ossona de Mendez on 2001/11/20 08:42:02
The raison why the message is so obscur and the program crashes is due to
a "bug" in function  external_meta (C part) which doesn't check all the arguments
type have been defined. Should be corrected in next release, so that a proper
error message will be written.
Message posted by pom on 2001/11/20 08:53:42
Yet another remark:
instead of writing

gvar uInt GGIFLAG_ASYNC := 0001h

you may write

constant GGIFLAG_ASYNC 0001h

remark that the constant object keeps it "natural type". You may also
ensure the type of the constant is what you want by performing a cast:

constant GGI_AUTO (cast 0 Int16)
Message posted by maybe Hubert Tonneau on 2001/11/20 08:59:19
Just another extra detail:
the meaningfull part of the crash report is:
. compile (Expression) +17
   file:ggi.pli (internals) 89 3
and it says that Pliant crashed while trying to execute 'compile' method
to the expression at line 89 column 3.

Two cents tip: when you get a crash report, just scan it top down,
               and look for a module name followed by two numbers (line and
               column).
Message posted by borisreitman on 2001/11/22 07:10:36
Thank you for your extensive help for getting this library wrapped.
I am now able to load the main window where I can draw...
(if you didn't know GGI is a graphics library).   

There are still problems -- i think ggi_color struct is not mapped properly,
because my colors are way off.  I checked the sizes of the C and Pliant
types, and they both show 8 bytes (correctly).

from ggi/types.h:

  typedef struct { uint16 r,g,b,a; } ggi_color;

in ggi.pli: 

public 
  type ggi_color
    packed
    field uInt16 r g b a

================================================================================

I am attaching what I've got so far.  For this to work, you need 

to export GGI_DISPLAY=x  

( to install libggi x target, do 
  apt-get install libggi-target-x if you are on debian )


Here we go,
================================================================================

# ggi.pli
# /borisreitman/ggi.pli
#BRZ: wrapper to the GGI library in c

# need this to allow casting to and from c types
module "/pliant/language/unsafe.pli"  # to use uInt32 etc

public 
  type ggi_color
    packed
    field uInt16 r g b a

  type ggi_coord
    packed
    field Int16 x y 

  type ggi_mode
    packed
    field Int32 frames
    field ggi_coord visible
    field ggi_coord virt
    field ggi_coord size
    field uInt32 graphtype  # uint32 = graphtype
    field ggi_coord dpp

################################################################################
### REWRITING MACROS ###
### CONSTANTS (define macros) ###

constant GT_AUTO         (cast 0     Int16)
constant GGI_AUTO        (cast 0     Int16)
constant GGIFLAG_ASYNC   (cast 0001h uInt)
constant GT_DEPTH_SHIFT  (cast 0     uInt)
constant GT_SCHEME_SHIFT (cast 24    uInt)
constant GT_DEPTH_MASK   (cast (FFh .*. 2^GT_DEPTH_SHIFT)  uInt)
constant GT_SCHEME_MASK  (cast (FFh .*. 2^GT_SCHEME_SHIFT) uInt)
constant GT_PALETTE      (cast (4h  .*. 2^GT_SCHEME_SHIFT) uInt)

constant GII_KT_SPEC (cast E0h uInt)
constant GII_KT_MOD  (cast E3h uInt)

function GII_KTYP x -> y
  arg Int x y
  y := x \ 2^8

function GII_KEY typ val -> retval 
  arg Int typ val retval
  retval := typ .*. 2^8;
  retval := retval .or. val;

constant GIIK_VOID ( cast (GII_KEY GII_KT_SPEC 0) Int )


function GT_DEPTH x -> y
  arg uInt32 x y;
  y := x .and. GT_DEPTH_MASK 
  y := y \ 2^GT_DEPTH_SHIFT

function GT_SCHEME x -> y    
  arg uInt32 x y
  y := x .and. GT_SCHEME_MASK


################################################################################
# FUNCTION DEFINITIONS

# int  ggiInit(void);
function ggiInit -> retval
  arg Int retval
  external "libggi.so" "ggiInit"

# int  ggiExit(void);
function ggiExit -> retval
  arg Int retval
  external "libggi.so" "ggiExit"

# ggi_visual_t ggiOpen(const char *display,...);
# function ggiOpen display arg_null -> vis
#   arg_r CStr display
#   arg Address arg_null;
#   arg Address vis;
#   external "libggi.so" "ggiOpen"
function ggiOpen arg_null -> vis
  #arg_r CStr display
  arg Address arg_null;
  arg Address vis;
  external "libggi.so" "ggiOpen"


# int          ggiClose(ggi_visual_t vis);
function ggiClose vis -> retval
  arg Address vis
  arg Int retval 
  external "libggi.so" "ggiClose"

# int        ggiSetFlags(ggi_visual_t vis,ggi_flags flags);
function ggiSetFlags vis flags -> retval 
  arg Address vis
  arg uInt flags
  arg Int retval
  external "libggi.so" "ggiSetFlags"

# ggi_flags  ggiGetFlags(ggi_visual_t vis);
function ggiGetFlags vis -> flags 
  arg Address vis
  arg uInt flags
  external "libggi.so" "ggiGetFlags"

# int ggiSetMode(ggi_visual_t visual,ggi_mode *tm);
function ggiSetMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiSetMode"

# int ggiGetMode(ggi_visual_t visual,ggi_mode *tm);
function ggiGetMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiGetMode"

# int ggiCheckMode(ggi_visual_t visual,ggi_mode *tm);
function ggiCheckMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiCheckMode"

# int ggiFlush(ggi_visual_t vis);
function ggiFlush vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiFlush"

# int ggiSetGCForeground(ggi_visual_t vis,ggi_pixel  color);
function ggiSetGCForeground vis color -> retval
  arg Address vis
  arg uInt32 color
  arg Int retval;
  external "libggi.so" "ggiSetGCForeground"

# int ggiGetGCForeground(ggi_visual_t vis,ggi_pixel *color);
function ggiGetGCForeground vis color -> retval
  arg Address vis
  arg Address color
  arg Int retval;
  external "libggi.so" "ggiGetGCForeground"

# int ggiSetGCBackground(ggi_visual_t vis,ggi_pixel  color);
function ggiSetGCBackground vis color -> retval
  arg Address vis
  arg uInt32 color
  arg Int retval
  external "libggi.so" "ggiSetGCBackground"

# int ggiGetGCBackground(ggi_visual_t vis,ggi_pixel *color);
function ggiGetGCBackground vis color -> retval
  arg Address vis
  arg Address color
  arg Int retval
  external "libggi.so" "ggiGetGCBackground"

# int ggiSetGCClipping(ggi_visual_t vis,int  left,int  top,int  right,int  bottom);
function ggiSetGCClipping vis left top right bottom -> retval
  arg Address vis
  arg Int left top right bottom
  arg Int retval
  external "libggi.so" "ggiSetGCClipping"

# int ggiGetGCClipping(ggi_visual_t vis,int *left,int *top,int *right,int *bottom);
function ggiGetGCClipping vis left top right bottom -> retval
  arg Address vis
  arg Address left top right bottom
  arg Int retval
  external "libggi.so" "ggiGetGCClipping"

# ggi_pixel ggiMapColor(ggi_visual_t vis,ggi_color *col);
function ggiMapColor vis color -> pixel
  arg Address vis
  arg Address color 
  arg uInt32 pixel
  external "libggi.so" "ggiMapColor"

#int ggiGetPalette(ggi_visual_t vis,int s,int len,ggi_color *cmap);
function ggiGetPalette vis s len cmap -> retval
  arg Address vis
  arg Int s len
  arg Address cmap
  arg Int retval
  external "libggi.so" "ggiGetPalette"

#int ggiSetPalette(ggi_visual_t vis,int s,int len,ggi_color *cmap);
function ggiSetPalette vis s len cmap -> retval
  arg Address vis
  arg Int s len
  arg Address cmap
  arg Int retval
  external "libggi.so" "ggiSetPalette"

#int ggiSetColorfulPalette(ggi_visual_t vis);
function ggiSetColorfulPalette vis -> retval 
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiSetColorfulPalette"

#int ggiSetOrigin(ggi_visual_t vis,int x,int y);
function ggiSetOrigin vis x y -> retval
  arg Address vis
  arg Int x y retval
  external "libggi.so" "ggiSetOrigin"

#int ggiGetOrigin(ggi_visual_t vis,int *x,int *y);
function ggiGetOrigin vis x y -> retval
  arg Address vis
  arg Address x y 
  arg Int retval
  external "libggi.so" "ggiGetOrigin"

#int ggiFillscreen(ggi_visual_t vis);
function ggiFillscreen vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiFillscreen"

#int ggiDrawPixel(ggi_visual_t vis,int x,int y);
function ggiDrawPixel vis x y -> retval
  arg Address vis
  arg Int x y 
  arg Int retval
  external "libggi.so" "ggiDrawPixel"
  
#int ggiKbhit(ggi_visual_t vis);
function ggiKbhit vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiKbhit"

#int ggiGetc(ggi_visual_t vis);
function ggiGetc vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiGetc"


########################## EXPORT ##############################################
export GII_KTYP 
export GII_KEY 
export GT_DEPTH 
export GT_SCHEME 
export ggiInit 
export ggiExit 
export ggiOpen 
export ggiClose 
export ggiSetFlags 
export ggiGetFlags 
export ggiSetMode 
export ggiGetMode
export ggiCheckMode 
export ggiFlush 
export ggiSetGCForeground 
export ggiGetGCForeground
export ggiSetGCBackground 
export ggiGetGCBackground 
export ggiSetGCClipping 
export ggiGetGCClipping 
export ggiMapColor 
export ggiGetPalette 
export ggiSetPalette
export ggiSetColorfulPalette 
export ggiSetOrigin 
export ggiGetOrigin 
export ggiFillscreen 
export ggiDrawPixel 
export ggiKbhit 
export ggiGetc 

export GT_AUTO   
export GGI_AUTO   
export GGIFLAG_ASYNC   
export GT_DEPTH_SHIFT  
export GT_SCHEME_SHIFT 
export GT_DEPTH_MASK   
export GT_SCHEME_MASK  
export GT_PALETTE      
export GII_KT_SPEC 
export GII_KT_MOD  
export GIIK_VOID

export ggi_color
export ggi_mode
export ggi_coord
#ggi.pli

================================================================================

#tryggi3.pli
#BRZ: test the ggi.pli wrapper
module "/borisreitman/ggi.pli"
module "/pliant/language/unsafe.pli"

gvar Address vis;

gvar uInt32 white;
gvar uInt32 black;

function main
  var Int repeat;
  var Int x y;
  var uInt32  type;

  var Array:ggi_color pal;
  pal size := 256;

  var Int depth:=0
  var Int doclip:=0
  var Int sx sy vx vy
  var ggi_color tmp_color;
  var Address memvis;

  #This buffer will hold data for the Get/Put functions.
  var Array:Int8 put_buf
  put_buf size := 64*1024

  # set-up the mode
  var ggi_mode mode;
  mode:frames := 1
  # default size
  # TODO: is there a way to assign in list-context, like in C or Perl
  mode:visible x := GGI_AUTO
  mode:visible y := GGI_AUTO
  mode:virt    x := GGI_AUTO
  mode:virt    y := GGI_AUTO

  # size in mm -- don't care
  mode:size    x := 0
  mode:size    y := 0
  mode:graphtype := GT_AUTO  # mode 
  # font size ?
  mode:dpp     x := GGI_AUTO
  mode:dpp     y := GGI_AUTO

  if ggiInit <> 0
    console "unable to initialize LibGGI, exiting.\n"
    #exit

  #vis := ggiOpen "x" null
  vis := ggiOpen null
  if vis = null
    console "Error: vis is null!" eol

  #ggiSetFlags vis GGIFLAG_ASYNC

  #Is the mode possible ? If not, a better one will be * suggested. 
  ggiCheckMode vis addressof:mode
  ggiSetMode   vis addressof:mode   # now try it. it *should* work! 
  
  #Now we read back the set mode, as it might have been autoselected or changed.
  type=mode:graphtype;
  vx:=mode:virt:x;    vy:=mode:virt:y;
  sx:=mode:visible:x; sy:=mode:visible:y;
  depth:=GT_DEPTH mode:graphtype
   
#  if GT_SCHEME:(mode:graphtype) = GT_PALETTE  
  console "setting colorfull palette" eol
  var Int retval := ggiSetColorfulPalette vis
  console "  retval: " retval eol
  ggiGetPalette vis 0 (1 .*. 2^depth) addressof:pal;
  
  # TODO: get's the wrong colors!
  # /* Find the colors "white" and "black".  */
  tmp_color r:=FFFFh; 
  tmp_color g:=FFFFh;
  tmp_color b:=FFFFh;

  console "SIZE OF ggi_color struct is" ggi_color:size;
  
  white := ggiMapColor vis addressof:tmp_color

  tmp_color r:=0; 
  tmp_color g:=0;
  tmp_color b:=0;
  black      := ggiMapColor vis addressof:tmp_color

  ggiSetFlags vis GGIFLAG_ASYNC

  for repeat 0 10
    ggiSetGCForeground vis  black # clear screen
    ggiFillscreen vis
    ggiSetGCForeground vis  white #  set white-on-black
    ggiSetGCBackground vis  black

    for (var Int x) 0 300
      y := x;
      ggiDrawPixel vis (x+repeat % 100) (y+repeat % 100);

    ggiFlush vis;
  #for    

  ggiGetc vis
  ggiClose vis
  ggiExit

main

================================================================================
here is the test file in C that works in
================================================================================
// try3.c

#include "config.h"
#ifndef HAVE_RANDOM
# define random rand
# define srandom srand
#endif

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <unistd.h>

#include <ggi/ggi.h>

ggi_visual_t vis;
ggi_pixel white;
ggi_pixel black;


int main(int argc, char **argv)
{
  int repeat;
  int x, y;
const char *prog; /* Make an alias for the program name */

ggi_graphtype type;
ggi_color pal[256];
  printf ("Size of ggi_color is: %d\n", sizeof( pal[0] ) );
int depth=0;
int doclip=0;
char *target_name=NULL;
int sx,sy,vx,vy;

ggi_color map[256];
ggi_visual_t memvis;
char put_buf[64*1024];

ggi_mode mode = { /* This will cause the default mode to be set */
1,                      /* 1 frame [???] */
{GGI_AUTO,GGI_AUTO},    /* Default size */
{GGI_AUTO,GGI_AUTO},    /* Virtual */
{0,0},                  /* size in mm don't care */
GT_AUTO,               /* Mode */
{GGI_AUTO,GGI_AUTO}     /* Font size */
};

if (ggiInit() != 0) {
fprintf(stderr, "%s: unable to initialize LibGGI, exiting.\n", prog);
exit(1);
}

  vis=ggiOpen(NULL);

if (vis == NULL) {
fprintf(stderr, "%s: unable to open default visual, exiting.\n", prog);
ggiExit();
exit(1);
}
ggiSetFlags(vis, GGIFLAG_ASYNC);

/* that's what we try. See what we get ... */
printf("Trying mode ");
ggiFPrintMode(stdout,&mode);
printf("\n");

/* Is the mode possible ? If not, a better one will be
 * suggested. 
 */

ggiCheckMode(vis,&mode);

printf("Suggested mode ");
ggiFPrintMode(stdout,&mode);
printf("\n");

ggiSetMode(vis,&mode);   /* now try it. it *should* work! */

/* Now we read back the set mode, as it might have been
 * autoselected or changed.
 */

type=mode.graphtype;
vx=mode.virt.x;    vy=mode.virt.y;
sx=mode.visible.x; sy=mode.visible.y;
depth=GT_DEPTH(mode.graphtype);


/* Set a colorful palette for the tests.
   Please note that GGI always uses 16 bit color components,
   so stretch the values accordingly when porting from DOS 
   or other libs that make assumptions about palette size.

   On some fixed-palette modes the ggiSetColorfulPalette()
   call will fail.  We silently ignore that.
 */
 
//if (GT_SCHEME(mode.graphtype) == GT_PALETTE) {
  ggiSetColorfulPalette(vis);
ggiGetPalette(vis, 0, 1<<depth, pal);
//}

/* Find the colors "white" and "black".
*/
map[0].r=0xFFFF; /* this is the highest intensity value for the red part. */
map[0].g=0xFFFF;
map[0].b=0xFFFF;

white=ggiMapColor(vis, &map[0]);
printf("white=%d\n", white);

map[0].r= map[0].g= map[0].b= 0x0;
black=ggiMapColor(vis, &map[0]);
printf("black=%d\n", black);

  ggiSetFlags(vis,GGIFLAG_ASYNC);

  for ( repeat = 0; repeat < 10; repeat++ )
  {
    ggiSetGCForeground(vis, black); // clear screen
    ggiFillscreen(vis);
    ggiSetGCForeground(vis, white); // set white-on-black
    ggiSetGCBackground(vis, black);

    for ( x = 0; x < 300; x++ )
    {
      //y = (int) ( sin((float)x) * 10 );
      y = x;Thank you for your extensive help for getting this library wrapped.
I am now able to load the main window where I can draw...
(if you didn't know GGI is a graphics library).   

There are still problems -- i think ggi_color struct is not mapped properly,
because my colors are way off.  I checked the sizes of the C and Pliant
types, and they both show 8 bytes (correctly).

from ggi/types.h:

  typedef struct { uint16 r,g,b,a; } ggi_color;

in ggi.pli: 

public 
  type ggi_color
    packed
    field uInt16 r g b a

================================================================================

I am attaching what I've got so far.  For this to work, you need 

to export GGI_DISPLAY=x  

( to install libggi x target, do 
  apt-get install libggi-target-x if you are on debian )


Here we go,
================================================================================

# ggi.pli
# /borisreitman/ggi.pli
#BRZ: wrapper to the GGI library in c

# need this to allow casting to and from c types
module "/pliant/language/unsafe.pli"  # to use uInt32 etc

public 
  type ggi_color
    packed
    field uInt16 r g b a

  type ggi_coord
    packed
    field Int16 x y 

  type ggi_mode
    packed
    field Int32 frames
    field ggi_coord visible
    field ggi_coord virt
    field ggi_coord size
    field uInt32 graphtype  # uint32 = graphtype
    field ggi_coord dpp

################################################################################
### REWRITING MACROS ###
### CONSTANTS (define macros) ###

constant GT_AUTO         (cast 0     Int16)
constant GGI_AUTO        (cast 0     Int16)
constant GGIFLAG_ASYNC   (cast 0001h uInt)
constant GT_DEPTH_SHIFT  (cast 0     uInt)
constant GT_SCHEME_SHIFT (cast 24    uInt)
constant GT_DEPTH_MASK   (cast (FFh .*. 2^GT_DEPTH_SHIFT)  uInt)
constant GT_SCHEME_MASK  (cast (FFh .*. 2^GT_SCHEME_SHIFT) uInt)
constant GT_PALETTE      (cast (4h  .*. 2^GT_SCHEME_SHIFT) uInt)

constant GII_KT_SPEC (cast E0h uInt)
constant GII_KT_MOD  (cast E3h uInt)

function GII_KTYP x -> y
  arg Int x y
  y := x \ 2^8

function GII_KEY typ val -> retval 
  arg Int typ val retval
  retval := typ .*. 2^8;
  retval := retval .or. val;

constant GIIK_VOID ( cast (GII_KEY GII_KT_SPEC 0) Int )


function GT_DEPTH x -> y
  arg uInt32 x y;
  y := x .and. GT_DEPTH_MASK 
  y := y \ 2^GT_DEPTH_SHIFT

function GT_SCHEME x -> y    
  arg uInt32 x y
  y := x .and. GT_SCHEME_MASK


################################################################################
# FUNCTION DEFINITIONS

# int  ggiInit(void);
function ggiInit -> retval
  arg Int retval
  external "libggi.so" "ggiInit"

# int  ggiExit(void);
function ggiExit -> retval
  arg Int retval
  external "libggi.so" "ggiExit"

# ggi_visual_t ggiOpen(const char *display,...);
# function ggiOpen display arg_null -> vis
#   arg_r CStr display
#   arg Address arg_null;
#   arg Address vis;
#   external "libggi.so" "ggiOpen"
function ggiOpen arg_null -> vis
  #arg_r CStr display
  arg Address arg_null;
  arg Address vis;
  external "libggi.so" "ggiOpen"


# int          ggiClose(ggi_visual_t vis);
function ggiClose vis -> retval
  arg Address vis
  arg Int retval 
  external "libggi.so" "ggiClose"

# int        ggiSetFlags(ggi_visual_t vis,ggi_flags flags);
function ggiSetFlags vis flags -> retval 
  arg Address vis
  arg uInt flags
  arg Int retval
  external "libggi.so" "ggiSetFlags"

# ggi_flags  ggiGetFlags(ggi_visual_t vis);
function ggiGetFlags vis -> flags 
  arg Address vis
  arg uInt flags
  external "libggi.so" "ggiGetFlags"

# int ggiSetMode(ggi_visual_t visual,ggi_mode *tm);
function ggiSetMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiSetMode"

# int ggiGetMode(ggi_visual_t visual,ggi_mode *tm);
function ggiGetMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiGetMode"

# int ggiCheckMode(ggi_visual_t visual,ggi_mode *tm);
function ggiCheckMode vis tm -> retval
  arg Address vis; 
  arg Address tm
  arg Int retval
  external "libggi.so" "ggiCheckMode"

# int ggiFlush(ggi_visual_t vis);
function ggiFlush vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiFlush"

# int ggiSetGCForeground(ggi_visual_t vis,ggi_pixel  color);
function ggiSetGCForeground vis color -> retval
  arg Address vis
  arg uInt32 color
  arg Int retval;
  external "libggi.so" "ggiSetGCForeground"

# int ggiGetGCForeground(ggi_visual_t vis,ggi_pixel *color);
function ggiGetGCForeground vis color -> retval
  arg Address vis
  arg Address color
  arg Int retval;
  external "libggi.so" "ggiGetGCForeground"

# int ggiSetGCBackground(ggi_visual_t vis,ggi_pixel  color);
function ggiSetGCBackground vis color -> retval
  arg Address vis
  arg uInt32 color
  arg Int retval
  external "libggi.so" "ggiSetGCBackground"

# int ggiGetGCBackground(ggi_visual_t vis,ggi_pixel *color);
function ggiGetGCBackground vis color -> retval
  arg Address vis
  arg Address color
  arg Int retval
  external "libggi.so" "ggiGetGCBackground"

# int ggiSetGCClipping(ggi_visual_t vis,int  left,int  top,int  right,int  bottom);
function ggiSetGCClipping vis left top right bottom -> retval
  arg Address vis
  arg Int left top right bottom
  arg Int retval
  external "libggi.so" "ggiSetGCClipping"

# int ggiGetGCClipping(ggi_visual_t vis,int *left,int *top,int *right,int *bottom);
function ggiGetGCClipping vis left top right bottom -> retval
  arg Address vis
  arg Address left top right bottom
  arg Int retval
  external "libggi.so" "ggiGetGCClipping"

# ggi_pixel ggiMapColor(ggi_visual_t vis,ggi_color *col);
function ggiMapColor vis color -> pixel
  arg Address vis
  arg Address color 
  arg uInt32 pixel
  external "libggi.so" "ggiMapColor"

#int ggiGetPalette(ggi_visual_t vis,int s,int len,ggi_color *cmap);
function ggiGetPalette vis s len cmap -> retval
  arg Address vis
  arg Int s len
  arg Address cmap
  arg Int retval
  external "libggi.so" "ggiGetPalette"

#int ggiSetPalette(ggi_visual_t vis,int s,int len,ggi_color *cmap);
function ggiSetPalette vis s len cmap -> retval
  arg Address vis
  arg Int s len
  arg Address cmap
  arg Int retval
  external "libggi.so" "ggiSetPalette"

#int ggiSetColorfulPalette(ggi_visual_t vis);
function ggiSetColorfulPalette vis -> retval 
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiSetColorfulPalette"

#int ggiSetOrigin(ggi_visual_t vis,int x,int y);
function ggiSetOrigin vis x y -> retval
  arg Address vis
  arg Int x y retval
  external "libggi.so" "ggiSetOrigin"

#int ggiGetOrigin(ggi_visual_t vis,int *x,int *y);
function ggiGetOrigin vis x y -> retval
  arg Address vis
  arg Address x y 
  arg Int retval
  external "libggi.so" "ggiGetOrigin"

#int ggiFillscreen(ggi_visual_t vis);
function ggiFillscreen vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiFillscreen"

#int ggiDrawPixel(ggi_visual_t vis,int x,int y);
function ggiDrawPixel vis x y -> retval
  arg Address vis
  arg Int x y 
  arg Int retval
  external "libggi.so" "ggiDrawPixel"
  
#int ggiKbhit(ggi_visual_t vis);
function ggiKbhit vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiKbhit"

#int ggiGetc(ggi_visual_t vis);
function ggiGetc vis -> retval
  arg Address vis
  arg Int retval
  external "libggi.so" "ggiGetc"


########################## EXPORT ##############################################
export GII_KTYP 
export GII_KEY 
export GT_DEPTH 
export GT_SCHEME 
export ggiInit 
export ggiExit 
export ggiOpen 
export ggiClose 
export ggiSetFlags 
export ggiGetFlags 
export ggiSetMode 
export ggiGetMode
export ggiCheckMode 
export ggiFlush 
export ggiSetGCForeground 
export ggiGetGCForeground
export ggiSetGCBackground 
export ggiGetGCBackground 
export ggiSetGCClipping 
export ggiGetGCClipping 
export ggiMapColor 
export ggiGetPalette 
export ggiSetPalette
export ggiSetColorfulPalette 
export ggiSetOrigin 
export ggiGetOrigin 
export ggiFillscreen 
export ggiDrawPixel 
export ggiKbhit 
export ggiGetc 

export GT_AUTO   
export GGI_AUTO   
export GGIFLAG_ASYNC   
export GT_DEPTH_SHIFT  
export GT_SCHEME_SHIFT 
export GT_DEPTH_MASK   
export GT_SCHEME_MASK  
export GT_PALETTE      
export GII_KT_SPEC 
export GII_KT_MOD  
export GIIK_VOID

export ggi_color
export ggi_mode
export ggi_coord
#ggi.pli

================================================================================

#tryggi3.pli
#BRZ: test the ggi.pli wrapper
module "/borisreitman/ggi.pli"
module "/pliant/language/unsafe.pli"

gvar Address vis;

gvar uInt32 white;
gvar uInt32 black;

function main
  var Int repeat;
  var Int x y;
  var uInt32  type;

  var Array:ggi_color pal;
  pal size := 256;

  var Int depth:=0
  var Int doclip:=0
  var Int sx sy vx vy
  var ggi_color tmp_color;
  var Address memvis;

  #This buffer will hold data for the Get/Put functions.
  var Array:Int8 put_buf
  put_buf size := 64*1024

  # set-up the mode
  var ggi_mode mode;
  mode:frames := 1
  # default size
  # TODO: is there a way to assign in list-context, like in C or Perl
  mode:visible x := GGI_AUTO
  mode:visible y := GGI_AUTO
  mode:virt    x := GGI_AUTO
  mode:virt    y := GGI_AUTO

  # size in mm -- don't care
  mode:size    x := 0
  mode:size    y := 0
  mode:graphtype := GT_AUTO  # mode 
  # font size ?
  mode:dpp     x := GGI_AUTO
  mode:dpp     y := GGI_AUTO

  if ggiInit <> 0
    console "unable to initialize LibGGI, exiting.\n"
    #exit

  #vis := ggiOpen "x" null
  vis := ggiOpen null
  if vis = null
    console "Error: vis is null!" eol

  #ggiSetFlags vis GGIFLAG_ASYNC

  #Is the mode possible ? If not, a better one will be * suggested. 
  ggiCheckMode vis addressof:mode
  ggiSetMode   vis addressof:mode   # now try it. it *should* work! 
  
  #Now we read back the set mode, as it might have been autoselected or changed.
  type=mode:graphtype;
  vx:=mode:virt:x;    vy:=mode:virt:y;
  sx:=mode:visible:x; sy:=mode:visible:y;
  depth:=GT_DEPTH mode:graphtype
   
#  if GT_SCHEME:(mode:graphtype) = GT_PALETTE  
  console "setting colorfull palette" eol
  var Int retval := ggiSetColorfulPalette vis
  console "  retval: " retval eol
  ggiGetPalette vis 0 (1 .*. 2^depth) addressof:pal;
  
  # TODO: get's the wrong colors!
  # /* Find the colors "white" and "black".  */
  tmp_color r:=FFFFh; 
  tmp_color g:=FFFFh;
  tmp_color b:=FFFFh;

  console "SIZE OF ggi_color struct is" ggi_color:size;
  
  white := ggiMapColor vis addressof:tmp_color

  tmp_color r:=0; 
  tmp_color g:=0;
  tmp_color b:=0;
  black      := ggiMapColor vis addressof:tmp_color

  ggiSetFlags vis GGIFLAG_ASYNC

  for repeat 0 10
    ggiSetGCForeground vis  black # clear screen
    ggiFillscreen vis
    ggiSetGCForeground vis  white #  set white-on-black
    ggiSetGCBackground vis  black

    for (var Int x) 0 300
      y := x;
      ggiDrawPixel vis (x+repeat % 100) (y+repeat % 100);

    ggiFlush vis;
  #for    

  ggiGetc vis
  ggiClose vis
  ggiExit

main

================================================================================
here is the test file in C that works in
================================================================================
// try3.c

#include "config.h"
#ifndef HAVE_RANDOM
# define random rand
# define srandom srand
#endif

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <unistd.h>

#include <ggi/ggi.h>

ggi_visual_t vis;
ggi_pixel white;
ggi_pixel black;


int main(int argc, char **argv)
{
  int repeat;
  int x, y;
const char *prog; /* Make an alias for the program name */

ggi_graphtype type;
ggi_color pal[256];
  printf ("Size of ggi_color is: %d\n", sizeof( pal[0] ) );
int depth=0;
int doclip=0;
char *target_name=NULL;
int sx,sy,vx,vy;

ggi_color map[256];
ggi_visual_t memvis;
char put_buf[64*1024];

ggi_mode mode = { /* This will cause the default mode to be set */
1,                      /* 1 frame [???] */
{GGI_AUTO,GGI_AUTO},    /* Default size */
{GGI_AUTO,GGI_AUTO},    /* Virtual */
{0,0},                  /* size in mm don't care */
GT_AUTO,               /* Mode */
{GGI_AUTO,GGI_AUTO}     /* Font size */
};

if (ggiInit() != 0) {
fprintf(stderr, "%s: unable to initialize LibGGI, exiting.\n", prog);
exit(1);
}

  vis=ggiOpen(NULL);

if (vis == NULL) {
fprintf(stderr, "%s: unable to open default visual, exiting.\n", prog);
ggiExit();
exit(1);
}
ggiSetFlags(vis, GGIFLAG_ASYNC);

/* that's what we try. See what we get ... */
printf("Trying mode ");
ggiFPrintMode(stdout,&mode);
printf("\n");

/* Is the mode possible ? If not, a better one will be
 * suggested. 
 */

ggiCheckMode(vis,&mode);

printf("Suggested mode ");
ggiFPrintMode(stdout,&mode);
printf("\n");

ggiSetMode(vis,&mode);   /* now try it. it *should* work! */

/* Now we read back the set mode, as it might have been
 * autoselected or changed.
 */

type=mode.graphtype;
vx=mode.virt.x;    vy=mode.virt.y;
sx=mode.visible.x; sy=mode.visible.y;
depth=GT_DEPTH(mode.graphtype);


/* Set a colorful palette for the tests.
   Please note that GGI always uses 16 bit color components,
   so stretch the values accordingly when porting from DOS 
   or other libs that make assumptions about palette size.

   On some fixed-palette modes the ggiSetColorfulPalette()
   call will fail.  We silently ignore that.
 */
 
//if (GT_SCHEME(mode.graphtype) == GT_PALETTE) {
  ggiSetColorfulPalette(vis);
ggiGetPalette(vis, 0, 1<<depth, pal);
//}

/* Find the colors "white" and "black".
*/
map[0].r=0xFFFF; /* this is the highest intensity value for the red part. */
map[0].g=0xFFFF;
map[0].b=0xFFFF;

white=ggiMapColor(vis, &map[0]);
printf("white=%d\n", white);

map[0].r= map[0].g= map[0].b= 0x0;
black=ggiMapColor(vis, &map[0]);
printf("black=%d\n", black);

  ggiSetFlags(vis,GGIFLAG_ASYNC);

  for ( repeat = 0; repeat < 10; repeat++ )
  {
    ggiSetGCForeground(vis, black); // clear screen
    ggiFillscreen(vis);
    ggiSetGCForeground(vis, white); // set white-on-black
    ggiSetGCBackground(vis, black);

    for ( x = 0; x < 300; x++ )
    {
      //y = (int) ( sin((float)x) * 10 );
      y = x;
      ggiDrawPixel(vis,x+repeat % 100,y+repeat % 100);
    }
    ggiFlush(vis);
  }

  ggiGetc(vis);
ggiClose(vis);
ggiExit();
return 0;

      ggiDrawPixel(vis,x+repeat % 100,y+repeat % 100);
    }
    ggiFlush(vis);
  }

  ggiGetc(vis);
ggiClose(vis);
ggiExit();
return 0;
Message posted by pom on 2001/11/22 08:27:21
What would be more convenient, for exchanges, would be to create a discussion
in the code forum.

Why?

Because then, you can make a gziped tarball of you files (tar czf myfiles.tgz /borisreitman/*.pli)
which you will be allowed to upload on the server. In the discussion, the gzip
tar will appears as separated files, which could then be viewed, downloaded
one by one, or downloaded as a gziped tarball.