\ Copyright 2022 Bradley D. Nelson 
\ 
\ Licensed under the Apache License, Version 2.0 (the "License"); 
\ you may not use this file except in compliance with the License. 
\ You may obtain a copy of the License at 
\ 
\     http://www.apache.org/licenses/LICENSE-2.0 
\ 
\ Unless required by applicable law or agreed to in writing, software 
\ distributed under the License is distributed on an "AS IS" BASIS, 
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 
\ See the License for the specific language governing permissions and 
\ limitations under the License. 
 
( Lazy load expand Graphics for Xlib ) 
 
graphics definitions 
 
: window r| 
 
also x11 
forth graphics internals definitions 
also posix also x11 
 
0 value display 
0 value screen 
0 value colormap 
0 value visual 
0 value screen-depth 
0 value black 
0 value white 
0 value root-window 
0 value window-handle 
0 value gc 
0 value image 
0 value xevent-type 
create xevent xevent-size allot 
256 constant keybuffer-size 
create keybuffer keybuffer-size allot 
0 value keybuffer-used 
 
ExposureMask 
ButtonPressMask or 
ButtonReleaseMask or 
KeyPressMask or 
KeyReleaseMask or 
PointerMotionMask or 
StructureNotifyMask or constant EVENT-MASK 
 
: image-resize { w h } 
  w to width   h to height 
  image if image XDestroyImage drop then 
  w h * 4* malloc dup 0= throw to backbuffer 
  display visual screen-depth ZPixmap 0 backbuffer 
    width height 32 width 4* XCreateImage to image 
; 
 
: update-mouse 
  [ xbutton ] 
  xevent ->x sl@ to mouse-x 
  xevent ->y sl@ to mouse-y 
; 
 
: update-key 
  [ xkey ] 
  xevent keybuffer keybuffer-size 
    0 >r rp@ NULL XLookupString to keybuffer-used 
    r> to last-key 
  PRESSED event = negate last-key key-state! 
; 
 
: pending-key? 
  keybuffer-used 0 <= if 0 exit then 
  keybuffer c@ to last-char 
  keybuffer 1+ keybuffer keybuffer-size 1- cmove> 
  keybuffer-used 1- to keybuffer-used 
  TYPED to event 
  -1 
; 
 
: update-event 
  IDLE to event 
  xevent [ xany ] ->type sl@ to xevent-type 
  Expose xevent-type = if 
    [ xexposure ] 
    xevent ->count @ 0= if 
      EXPOSED to event 
      exit 
    then 
  then 
  ConfigureNotify xevent-type = if 
    RESIZED to event 
    [ xconfigure ] 
    xevent ->width sl@ xevent ->height sl@ image-resize 
    exit 
  then 
  KeyPress xevent-type = if 
    PRESSED to event 
    update-mouse 
    update-key 
    exit 
  then 
  KeyRelease xevent-type = if 
    RELEASED to event 
    update-mouse 
    update-key 
    exit 
  then 
  ButtonPress xevent-type = if 
    PRESSED to event 
    update-mouse 
    ( uses carnal knowledge ) 
    [ xbutton ] 256 xevent ->button sl@ - to last-key 
    1 last-key key-state! 
    exit 
  then 
  ButtonRelease xevent-type = if 
    RELEASED to event 
    update-mouse 
    ( uses carnal knowledge ) 
    [ xbutton ] 256 xevent ->button sl@ - to last-key 
    0 last-key key-state! 
    exit 
  then 
  MotionNotify xevent-type = if 
    MOTION to event 
    update-mouse 
    exit 
  then 
; 
 
also graphics definitions 
 
: window { w h } 
  w 0< if 640 to w 480 to h then 
  NULL XOpenDisplay to display 
  display XDefaultScreen to screen 
  display screen XDefaultColorMap to colormap 
  display screen XDefaultVisual to visual 
  display screen XDefaultDepth to screen-depth 
  display screen XBlackPixel to black 
  display screen XWhitePixel to white 
  display screen XRootWindow to root-window 
  display root-window 0 0 w h 0 black white 
    XCreateSimpleWindow to window-handle 
  display window-handle XMapWindow drop 
  display window-handle 0 NULL XCreateGC to gc 
  display window-handle EVENT-MASK XSelectInput drop 
  1 1 image-resize 
; 
 
: flip 
  display window-handle gc image 
    0 0 0 0 width height XPutImage drop 
; 
 
: wait 
  pending-key? if exit then 
  display xevent XNextEvent drop 
  update-event 
; 
 
: poll 
  pending-key? if exit then 
  display event-mask xevent XCheckMaskEvent 
    if update-event else IDLE to event then 
; 
 
forth definitions 
previous previous previous previous 
window 
| evaluate ; 
 
forth definitions 
 

Legal: site web personnel sans commerce / personal site without seling