add sticky flag

files/main.gs

@@ -1,102 +1,31 @@
-/eventhandler_vars ( /type 0 /key 0 /action 0 ) def
+getcanvas getconsole setcanvas getfont exch setcanvas setfont
 
-/eventhandler {
-  eventhandler_vars setdict
-
-  /type exch def
-  /key exch def
-
-  key edit .input
-
-  action
-} def
-
-/setrpos {
-  getpos rot add exch rot add exch setpos
-} def
-
-# - - - - - - - - - - - - - - -
-
-/edit (
-  /x 0
-  /y 0
-  /width 0
-  /height 0
-  /background nil
-  /x_shift 0
-  /cursor_index 0
-  /cursor_x [ 0 ]
-  /buf [ ]
-
-  /init {
-    /height exch def
-    /width exch def
-    getpos
-    /y exch def
-    /x exch def
-    /background width height newcanvas def
-    getcolor
-      0x90000000 setcolor
-      width height fillrect
-    setcolor
-    getregion
-      x y width height setregion
-      background getcanvas blt
-    setregion
-    x y setpos
-    getcanvas background blt
-  }
-
-  /text {
-    buf encodeutf8
+/widget (
+  /draw1 {
+    10 y setpos
+    text show
   }
+) def
 
-  /input {
-    /key exch def
-
-    key 0x0d eq {
-      debug
-      text
-      return
-    } if
-
-    buf [ key ] add! pop
-    cursor_x -1 get x add y setpos
-    key show
-    cursor_x [ getpos pop x sub ] add! pop
+/win (
+  /y 20
+  /text "XX"
+  /draw2 {
+    debug
+    10 y setpos
+    text show
+    /y y 20 add def
+    /text text " XX" add def
   }
 ) def
 
-# - - - - - - - - - - - - - - -
-
-/console-font getcanvas getconsole setcanvas getfont exch setcanvas def
-
-/dejavu-sans-24 "dejavu-sans-24.fnt" readfile newfont def
-
-/title "ABC 12345ijklmn xyz # * % & § öäüß €" def
-
-/katze "katze_%04u.jpg" [ getcanvas dim pop ] format readfile
- dup nil eq { console-font setfont 0 20 setpos 0xff0000 setcolor "Error: no backgound image" show return } if
-unpackimage def
-
-0 0 setpos
-getcanvas katze blt
-
-dejavu-sans-24 setfont
-
-getcanvas dim pop title dim pop sub 2 div 50 setpos
-
-0x90000000 setcolor
--10 -5 setrpos
-title dim 10 add exch 20 add exch fillrect
-10 5 setrpos
-
-0xffffff setcolor
-title show
+win widget setparent
 
-100 460 setpos
-600 30 edit .init
+/win_i ( ) def
+win_i win setparent
 
-/eventhandler seteventhandler
+win_i .draw2
+win_i .draw2
+win_i .draw2
 
-0 0 setpos
+win_i .draw1

gfxboot.h

@@ -234,6 +234,7 @@ typedef struct {
     uint8_t nofree:1;		// data.ptr is unmanaged and must not be freed; if data.ref_id is set, object is relative to data.ref_id
     uint8_t has_ref:1;		// object has been referenced via data.ref_id in another object
     uint8_t utf8:1;		// data is utf8 encoded
+    uint8_t sticky:1;		// create new hash entries here
   } flags;
 } obj_t;
 

gfxboot_obj.c

@@ -129,13 +129,14 @@ char *gfx_obj_id2str(obj_id_t id)
   // corresponds to OTYPE_* defines
   static const char *names[] = { "nil", "mem", "olist", "font", "canv", "array", "hash", "ctx", "num" };
   static char buf[64], buf2[32];
-  const char *s, *sub_type = "", *ro = "";
+  const char *s, *sub_type = "", *ro = "", *sticky = "";
   unsigned idx = OBJ_ID2IDX(id);
   unsigned gen = OBJ_ID2GEN(id);
 
   obj_t *ptr = gfx_obj_ptr_nocheck(id);
   if(ptr && id) {
     if(ptr->flags.ro) ro = ".ro";
+    if(ptr->flags.sticky) sticky = ".sticky";
     if(ptr->sub_type) {
       if(ptr->sub_type < sizeof type_name / sizeof *type_name) {
         sub_type = type_name[ptr->sub_type];
@@ -157,7 +158,7 @@ char *gfx_obj_id2str(obj_id_t id)
     *buf2 = 0;
   }
 
-  gfxboot_snprintf(buf, sizeof buf, "#%u.%u%s.%s%s%s%s", idx, gen, buf2, s, *sub_type ? "." : "", sub_type, ro);
+  gfxboot_snprintf(buf, sizeof buf, "#%u.%u%s.%s%s%s%s%s", idx, gen, buf2, s, *sub_type ? "." : "", sub_type, ro, sticky);
 
   return buf;
 }

gfxboot_prim.c

@@ -3303,6 +3303,29 @@ void gfx_prim_freeze()
 }
 
 
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+// make hash sticky
+//
+// group: mem
+//
+// ( hash_1 -- hash_1 )
+//
+// Mark hash as sticky.
+//
+// example:
+//
+// getdict sticky
+//
+void gfx_prim_sticky()
+{
+  arg_t *argv = gfx_arg_1(OTYPE_HASH);
+
+  if(!argv) return;
+
+  if(argv[0].ptr) argv[0].ptr->flags.sticky = 1;
+}
+
+
 // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 // get drawing color
 //

vocabulary.def

@@ -35,6 +35,7 @@ over
 index
 exec
 add
+add!	add_direct
 sub
 mul
 div
@@ -61,6 +62,7 @@ setparent
 getdict
 setdict
 freeze
+sticky
 getcolor
 setcolor
 getbgcolor
@@ -100,4 +102,3 @@ setcompose
 updatescreen
 geteventhandler
 seteventhandler
-add!	add_direct