JSON-GET indexes arrays with integer attributes (#2140)

* I put in support for standard color specifications. I think this is pretty close.
BLTSHADE, FILLCIRCLE, and FILLPOLYGON with the TEXTURE as TEXTUREP or BITMAPP convert to a gray scale as a function of the number of bits set.
It'll take a bunch more refreshing of PostScript knowledge to figure out how to do these with real colors, and actual pixel-by-pixel textures.

lispusers/JSON

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36
 9198   
+
(FILECREATED " 7-May-2025 13:57:04" {WMEDLEY}<lispusers>JSON.;38
 9891   
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS JSON-GET)
 
-      :PREVIOUS-DATE "13-May-2024 19:23:02" {WMEDLEY}<lispusers>JSON.;33)
+      :PREVIOUS-DATE "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36)
 
 
 (PRETTYCOMPRINT JSONCOMS)
@@ -177,14 +177,24 @@
          NIL])
 
 (JSON-GET

-  [LAMBDA (OBJECT ATTRIBUTES)
                                (* ; "Edited 13-May-2024 22:35 by rmk")


+  [LAMBDA (OBJECT ATTRIBUTES)
                                (* ; "Edited  7-May-2025 13:56 by rmk")


+                                                             (* ; "Edited 13-May-2024 22:35 by rmk")


                                                              (* ; "Edited 30-Apr-2024 14:26 by rmk")

 
     (* ;; "Returns the value at the end of a chain of ATTRIBUTES in OBJECT")

 
-    (for
 A (OBJ _ OBJECT) inside
 ATTRIBUTES do
 (if
 (EQ 'OBJECT (CAR (LISTP OBJ)))
-                                                   then
 [SETQ OBJ (CADR (ASSOC A (CDR OBJ]
-                                                 else
 (RETURN NIL)) finally
 (RETURN OBJ])
+    (for
 A (OBJ _ OBJECT) inside
 ATTRIBUTES do
 (SELECTQ (CAR (LISTP OBJ))
+                                                   (OBJECT [SETQ OBJ (CADR (ASSOC A (CDR OBJ])
+                                                   (ARRAY (CL:UNLESS (AND (FIXP A)
+                                                                          (IGEQ A 0))
+                                                                 (ERROR A 
+                                                                        " cannot index a JSON array")
+                                                                 )
+
+                                                          (* ;; "ADD1 because zero-origin")

+
+                                                          [SETQ OBJ (CAR (NTH OBJ (ADD1 A])
+                                                   (RETURN NIL)) finally
 (RETURN OBJ])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -201,7 +211,7 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (559 8839 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) (
+  (FILEMAP (NIL (559 9532 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) (
 JSON-STRING 1564 . 2362) (JSON-ARRAY 2364 . 3502) (JSON-OBJECT 3504 . 4961) (JSON-AVPAIR 4963 . 5405) 
-(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 8837)))))
+(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 9530)))))
 STOP

lispusers/READ-BDF

@@ -5,14 +5,13 @@ BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY
 FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) 
 READTABLE "XCL" BASE 10)
 
-
(IL:FILECREATED "25-Apr-2025 10:10:08" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;57|
 47436  
+
(IL:FILECREATED "30-Apr-2025 13:20:10" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;61|
 47500  
 
       :EDIT-BY "mth"
 
-      :CHANGES-TO (IL:FUNCTIONS WRITE-BDF-TO-DISPLAYFONT-FILES READ-BDF BDF-TO-CHARSETINFO READ-GLYPH
-                         GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME)
+      :CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME)
 
-      :PREVIOUS-DATE "23-Apr-2025 17:55:25" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;54|
+      :PREVIOUS-DATE "25-Apr-2025 10:10:08" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;60|
 )
 
 
@@ -282,10 +281,11 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                                              :TEST
                                                              #'EQL)))))))))
 
-(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME
 (BDFONT)
        (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth")


+(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME
 (BDFONT)
        (IL:* IL:\; "Edited 30-Apr-2025 13:18 by mth")


+                                                      (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth")


                                                       (IL:* IL:\; "Edited  5-Feb-2025 12:56 by mth")

    (UNLESS (TYPEP BDFONT 'BDF-FONT)
-          (ERROR "Not a  BDF-FONT: ~S~%" BDFONT))
+          (ERROR "Not a BDF-FONT: ~S~%" BDFONT))
    (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME
                               PIXEL-SIZE POINT-SIZE)
           (SPLIT-FONT-NAME
 (BF-NAME BDFONT))                 (IL:* IL:\; "Parse as XLFD format")

@@ -300,10 +300,11 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                                      (#\D . BOLD)
                                                      (#\L . LIGHT)))))
                            'MEDIUM))                         (IL:* IL:\; "DemiBold => BOLD")

-          (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (STRING-UPCASE SLANT)
-                                                 '(("R" . REGULAR)
-                                                   ("I" . ITALIC)
-                                                   ("O" . ITALIC)))))
+          (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (CHAR-UPCASE (ELT SLANT 0))
+                                                 '((REGULAR)
+                                                   (#\R . REGULAR)
+                                                   (#\I . ITALIC)
+                                                   (#\O . ITALIC)))))
                           'REGULAR))                         (IL:* IL:\; "Oblique => ITALIC")

                                                              (IL:* IL:\; "Ignore others")

           (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0))
@@ -822,10 +823,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
 
 (IL:PUTPROPS IL:READ-BDF
 IL:DATABASE
 IL:NO)
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (2427 10386 (BDF-TO-CHARSETINFO 2427 . 10386)) (10388 16258 (BDF-TO-FONTDESCRIPTOR 
-10388 . 16258)) (16260 19623 (GET-FAMILY-FACE-SIZE-FROM-NAME 16260 . 19623)) (19625 26436 (
-GLYPHS-BY-CHARSET 19625 . 26436)) (26438 27863 (PACKFILENAME.STRING 26438 . 27863)) (27865 34669 (
-READ-BDF 27865 . 34669)) (34671 34994 (READ-DELIMITED-LIST-FROM-STRING 34671 . 34994)) (34996 41484 (
-READ-GLYPH 34996 . 41484)) (41486 42227 (SPLIT-FONT-NAME 41486 . 42227)) (42229 46011 (
-WRITE-BDF-TO-DISPLAYFONT-FILES 42229 . 46011)))))
+  (IL:FILEMAP (NIL (2316 10275 (BDF-TO-CHARSETINFO 2316 . 10275)) (10277 16147 (BDF-TO-FONTDESCRIPTOR 
+10277 . 16147)) (16149 19687 (GET-FAMILY-FACE-SIZE-FROM-NAME 16149 . 19687)) (19689 26500 (
+GLYPHS-BY-CHARSET 19689 . 26500)) (26502 27927 (PACKFILENAME.STRING 26502 . 27927)) (27929 34733 (
+READ-BDF 27929 . 34733)) (34735 35058 (READ-DELIMITED-LIST-FROM-STRING 34735 . 35058)) (35060 41548 (
+READ-GLYPH 35060 . 41548)) (41550 42291 (SPLIT-FONT-NAME 41550 . 42291)) (42293 46075 (
+WRITE-BDF-TO-DISPLAYFONT-FILES 42293 . 46075)))))
 IL:STOP

scripts/lsee

@@ -13,7 +13,7 @@
 export LANG=en_US.UTF-8
 tr '\r' '\n' < $1 | \
     sed -e 's/_/←/g'        \
-	-e 's/^/↑/g'        \
+	-e 's/\^/↑/g'        \
 	-e 's/
//g' \
 	-e 's///g'\
 	-e 's///g' \