#! /usr/bin/env ueforth 
 
\ 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. 
 
DEFINED? windows [IF] windows dpi-aware [THEN] 
also graphics 
also structures 
 
struct ScanSpan 
  ptr field ->next 
  ptr field ->edge 
 
2048 constant max-scanlines 
create scanlines max-scanlines cells allot 
scanlines max-scanlines cells erase 
0 value free-edges 
 
: new-edge ( n next -- a ) 
  free-edges if 
    free-edges dup ->next @ to free-edges 
  else 
    ScanSpan allocate throw 
  then 
  { np } 
  np ->next ! 
  np ->edge ! 
  np 
; 
: row-span ( y -- a ) cells scanlines + ; 
: add-edge { x y } 
  y 0< y max-scanlines >= or if exit then 
  y row-span { yp } 
  begin yp @ while 
    x yp @ ->edge @ <= if 
      x yp @ new-edge yp ! 
      exit 
    then 
    yp @ ->next to yp 
  repeat 
  x yp @ new-edge yp ! 
; 
: remove-edge ( y -- x ) 
  row-span { yp } 
  yp @ 0= if 10000 exit then 
  yp @ { old } 
  yp @ ->edge @ 
  yp @ ->next @ yp ! 
  free-edges old ->next ! 
  old to free-edges 
; 
: draw-row { y } 
  begin y row-span @ while 
    y remove-edge y remove-edge over - y swap 1 box 
  repeat 
; 
: draw-spans max-scanlines 0 do i draw-row loop ; 
 
: 0.<< ( n -- n ) 16 lshift ; 
: 0.>> ( n -- n ) 16 arshift ; 
 
: line ( x1 y1 x2 y2 ) 
  0 0 0 0 { x1 y1 x2 y2 dx dy sy ey } 
  y1 y2 > if 
    y1 y2 to y1 to y2 
    x1 x2 to x1 to x2 
  then 
  x2 x1 - to dx 
  y1 0.>> to sy 
  y2 0.>> to ey 
  ey sy - to dy 
  dy 0 ?do 
    x1 dx i dy */ + 0.>> sy i + add-edge 
  loop 
; 
 
: distance2 { x1 y1 x2 y2 } x1 x2 - dup * y1 y2 - dup * + ; 
 
: raw-bezier 0 0 { x1 y1 x2 y2 x3 y3 d xn yn } 
  d 0< if 
    x1 y1 x3 y3 line 
  else 
    x1 x2 2* + x3 + 2/ 2/ to xn 
    y1 y2 2* + y3 + 2/ 2/ to yn 
    x1 y1   x1 x2 + 2/ y1 y2 + 2/  xn yn   d 1- recurse 
    xn yn   x2 x3 + 2/ y2 y3 + 2/  x3 y3   d 1- recurse 
  then 
; 
 
: bezier 10 raw-bezier ; 
 
0 value pen-x   0 value pen-y 
: move-to { x y } x 0.<< to pen-x   y 0.<< to pen-y ; 
: line-to { x y } pen-x pen-y x 0.<< y 0.<< line   x y move-to ; 
: bezier-to { x' y' x y } pen-x pen-y x' 0.<< y' 0.<< x 0.<< y 0.<< bezier  x y move-to ; 
 
-1 -1 window 
 
$ff0000 constant red 
$ffff00 constant yellow 
$ffffff constant white 
$000000 constant black 
$0000bb constant blue 
 
: draw 
  black to color  0 0 width height box 
  yellow to color  0 0 width 2/ height 2/ box 
 
  red to color 
  width 3 / 100 move-to 
  mouse-x 1 mouse-x mouse-y bezier-to 
  mouse-x 2/ 1 line-to 
  300 200 200 400 bezier-to 
  1 mouse-y 2 3 */ line-to 
  width 3 / 100 line-to 
  blue to color   draw-spans 
 
  flip 
; 
 
: run 
  begin 
    poll 
    IDLE event = if draw then 
  event FINISHED = until 
  bye 
; 
run 
 

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