!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!     Utility.h                         A library of reasonably useful
!                                       Inform 6 functions by
!       V 4.0                           L. Ross Raszewski
!
! New in 4.0: Glulx support (requires infglk)
!             Finally fixed the "strict mode" conflict in center
!             New functions:
!               Abs, Pow, BoldIt, SInsert, ScriptPrint,
!               get_window_from_stream (glulx only)
! New in 3.2: New functions: Age, DaemonRunning, TimerRunning
! New in 3.1: Automatic V6lib support, new function: LocateCursor
!               Special thanks to Jason C. Penny for V6 modifications
! New in 3.0: New function: Rmove
!             Moved Center and CenterU to Utility.h
! New in 2.1: I learned to spell "Underline"
! New in 2.0:  Symbolic constants for Emphasis system.
!              New Documentation
!              Slight change to Emphasis.
!
! I've recenly realized that I've been using functions in my libraries as if
! everyone had them, when in fact, they don't.  The surprising lack of
! commentary I've gotten on these has resulted in my not having noticed this
! sooner.  This library contains all the non-standard functions called by my
! libraries.  These functions are also available for public use.  A
! description of each appears before it
!
! e-mail me at [email protected]
ifndef WORDSIZE;
Constant WORDSIZE 2;
Constant TARGET_ZCODE;
endif;
ifdef TARGET_GLULX;
include "infglk";
endif;
System_File;
ifndef UTILITY_LIBRARY;
Constant UTILITY_LIBRARY 32;
ifndef strict;
global strict=0;
endif;
ifndef temp_obj;
Object temp_obj;
endif;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Pmove - moves obj1 into obj2 as the youngest child
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ Pmove obj1 obj2 o;
  for (o=child(obj2):o ofclass Object: o=child(obj2)) move o to temp_obj;
  move obj1 to obj2;
  for (o=child(temp_obj):o ofclass Object: o=child(temp_obj)) move o to obj2;
];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Rmove - moves obj1 as the immediate younger sibling of obj2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ Rmove obj1 obj2 o i;
  i=parent(obj2);
  for(o=child(i):o~=obj2:o=child(i)) move o to temp_obj;
  move obj2 to temp_obj;
  move obj1 to i;
  for(o=child(temp_obj):o ofclass Object:o=child(temp_obj)) move o to i;
];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Emphasis - changes the text emphasis setting
!          The global variable Emphasis_Color stores the color for
!          Emphasis(3);  The default is green.
!            Emphasis(0) - normal text
!            Emphasis(1) - bold
!            Emphasis(2) - Underline
!            Emphasis(3) - Color (if available)
!            Emphasis(4) - Reverse
!          To use Emphasis in a print statement, be sure to use the inform
!          format for embedded print statements:
!          "This word is in ", (Emphasis) COLOR, "color", (Emphasis) NORMAL,
!          ".";
!         The symbolic constants below can be used in place of numbers.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Constant NORMAL 0;
Constant BOLD   1;
Constant UNDERLINE 2;
Constant COLOR 3;
Constant REVERSE 4;
! Color Settings
Constant DFLT 1;
Constant BLACK 2;
Constant RED 3;
Constant GREEN 4;
Constant YELLOW 5;
Constant BLUE 6;
Constant MAGENTA 7;
Constant CYAN 8;
Constant WHITE 9;
Global Emphasis_Color=4;        ! Default color is green
[ Emphasis n;
#ifdef TARGET_ZCODE;
switch(n){
0: style roman;
#ifndef SPECTEST_AVAILABLE;
        if (standard_interpreter>=2 ) @set_colour 1 1;
#ifnot;
       if (standard_interpreter>=2 || Spec->ColorFlag) @set_colour 1 1;
#endif;
1: style bold;
2: style underline;
3:
if (Emphasis_Color==-1) style reverse;
else if (Emphasis_Color==-2) print "*";
else {
#ifndef SPECTEST_AVAILABLE;
       if ( (standard_interpreter) >= 2&& (0->1)&1)
        @set_colour Emphasis_Color 1;
       else style underline;
#ifnot;
       if ( ((standard_interpreter) >= 2 || Spec->ColorFlag)  && (0->1)&1)
        @set_colour Emphasis_Color 1;
       else style underline;
#endif;
}
4: style reverse;
}
#ifnot;
switch(n)
{
0: glk_set_style(style_Normal);
1: glk_set_style(style_Emphasized);
2: glk_set_style(style_User1);
3: glk_set_style(style_User2);
4: glk_set_style(style_BlockQuote);
}
#endif;
];

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! WaitForKey - waits for a keypress.  Takes as an argument a string to be
!              printed.  if none is given, it prints the default.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ WaitForKey str;
if (str==0) str="[Press Any Key]";
if (str ofclass string) print (string) str;
else if (str ofclass routine) indirect(str);
#ifdef TARGET_ZCODE;
@read_char 1 str;
#ifnot;
KeyCharPrimitive();
#endif;

];


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Scion - Finds a child of certain "age"; scion(o,1) is the child of an object
!         scion(o,2) is the sibling of the child, and so on.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

[ Scion Object x i;
       if (x==0) return Object;
       x--;
       i=child(Object);
       while (x>0 && i~=nothing)
        { i=sibling(i); x--; }
       return i;
];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Age -  Returns the "age" of a object, such that the eldest child of an
!        object has age 1, and so on; Scion(parent(x),Age(x))==x
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ Age obj x y;
  x=1;
  y=child(parent(obj));
  while (y~=obj)
  {
   x++;
   y=sibling(y);
  }
  return x;
];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Center - Centers a line of text on the current line
!       Center(x); where x is a line of text or a routine to print one
!       (this routine shoud ONLY print text, as it will be called twice)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Array CenterText -> 80;
[ Center instring i;
#ifdef TARGET_ZCODE;
   CenterText-->0 = 78;
   @output_stream 3 CenterText;
   if (instring ofclass string)
       print (string) instring;
   if (instring ofclass Routine)
       indirect(instring);
   @output_stream -3;
   #Ifdef V6DEFS_H;
   i = ActiveZWindow.GetXSize();
   i = i - 0-->($30/2);
   i = i/2;
   ActiveZWindow.SetCursor(0, i);
   #Ifnot;
   i = 0->$21;
   i = i - CenterText-->0;
   i = i/2;
   font off;
   spaces(i);
   #endif;
   if (instring ofclass string)
       print (string) instring;
   if (instring ofclass Routine)
       indirect(instring);
  #ifndef V6DEFS_H;
   font on;
  #endif;
#ifnot;
glk_window_get_size(get_window_from_stream(glk_stream_get_current()),
                    gg_arguments,gg_arguments+WORDSIZE);
i=PrintAnyToArray(CenterText,80,instring);
glk_set_style(style_Preformatted);
spaces(((gg_arguments-->0)-i)/2);
PrintAnything(instring);

glk_set_style(style_Normal);
#endif;

];


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! CenterU - Centers a line of text in the upper window
!           CenterU(x,y) where y is the line of the upper window on which to
!           print the line
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ CenterU instring j i;
#ifdef TARGET_ZCODE;
   CenterText-->0 = 128;
   @output_stream 3 CenterText;
   if (instring ofclass string)
       print (string) instring;
   if (instring ofclass Routine)
       indirect(instring);
   @output_stream -3;
   #Ifdef V6DEFS_H;
   i = ActiveZWindow.GetXSize();
   i = i - 0-->($30/2);
   i = i/2;
   ActiveZWindow.SetCursorByChar(j,0);
   ActiveZWindow.SetCursor(0, i);
   #Ifnot;
   i = 0->$21;
   i = i - CenterText-->0;
   i = i/2;
   @set_cursor j i;
   #endif;
   if (instring ofclass string)
       print (string) instring;
   if (instring ofclass Routine)
       indirect(instring);
#ifnot;
glk_window_get_size(get_window_from_stream(glk_stream_get_current()),
                    gg_arguments,gg_arguments+WORDSIZE);
j=PrintAnyToArray(CenterText,80,instring);

LocateCursor(i,(gg_arguments-->0-j)/2);
PrintAnything(instring);

! glk_set_style(style_Normal);


#endif;

];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! LocateCursor - places the cursor within the upper window
!                LocateCursor(y,x) places the cursor at position x,y on the
!                screen.  This is a version independant function, which will
!                place the cursor by characters in v5/8 or v6.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ LocateCursor y x;
#ifdef TARGET_ZCODE;
if (strict && 0==x or y) return;
#Ifdef V6DEFS_H;
 StatusWin.SetCursorByChar(y,x);
#Ifnot;
 @set_cursor y x;
#Endif;
#ifnot;
glk_window_move_cursor(gg_statuswin,x-1,y-1);
#endif;

];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! DaemonRunning - Returns TRUE if the object specified is currently running
!                 a daemon
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ DaemonRunning x i;
  for (i=0:i<active_timers:i++)
      if (the_timers-->i == $8000 + x)
          rtrue;
  rfalse;
];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! TimerRunning - Returns TRUE if the object specified is currently running
!                 a timer
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ TimerRunning x i;
  for (i=0:i<active_timers:i++)
      if (the_timers-->i ==x)
          rtrue;
  rfalse;
];

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Abs - Returns the absolute value of a number
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ abs x;
 if (x<0) return -x;
 else return x;
];
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Boldit - prints a string in bold
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ Boldit x;
Emphasis(1);
print (string) x;
Emphasis(0);
];

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Pow(x,y) - returns x^y
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ pow x y z;
z=1;
while(y>0)
{z=z*x;
 y--;
}
return z;
];

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! get_window_from_stream - returns the window with which a stream is
!                       associated (suitable only for finding the
!                       "current" window)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ifdef TARGET_GLULX;
[ get_window_from_stream str i;
i=0;
i=glk_window_iterate(i,gg_arguments);
while(i)
{
 if (str == glk_window_get_stream(i))
  return i;
 i=glk_window_iterate(i,gg_arguments);
}
return 0;
];
endif;

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! sinsert(x,y,comp) - Inserts x into y in sorted position. Comp is a function
!               which takes two arguments, and returns <, >, or =  zero
!               if the first object goes before, after, or at the same point
!               in the sorting order as the second.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ sinsert x y func o i l;
objectloop(o in y)
{
 i=func(x,o);
 if (i>0) break;
 l=o;
}
if (o==nothing) ! o is the last one, x goes after it, or
 pmove(x,y);
else if (l<=0) ! it goes before the first one
 move x to y;
else
 rmove(x,l);
];

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! ScriptPrint - Print to the transcript; if scripting is enabled, print
!       x to the transcript. if x is a function, a second parameter will be
!       passed to it.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#ifdef TARGET_ZCODE;
[ ScriptPrint x y;
if (transcript_mode)
{
@output_stream -1;
if (x ofclass string) print (string) x;
else x(y);
@output_stream 1;
}
];
ifnot;
[ ScriptPrint x y z;
if (gg_scriptstr)
{
 z=glk_stream_get_current();
 glk_stream_set_current(gg_scriptstr);
 PrintAnything(x,y);
 glk_stream_set_current(z);
}
];
endif;
endif;

You are viewing proxied material from mercury.661.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.