Re-root site.

2022-02-27 20:59:19 -08:00
parent a26786d7ef
commit fb47179999
131 changed files with 27 additions and 39 deletions
--- a/posix/grf.fs
+++ b/posix/grf.fs
@ -0,0 +1,174 @@
+\ 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 )
+
+grf definitions
+
+: window r|
+
+also x11
+forth grf 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 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 grf 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