Improving grf.
This commit is contained in:
@ -14,15 +14,35 @@
|
||||
|
||||
grf
|
||||
|
||||
$00ccff value color
|
||||
|
||||
: hline { x y w }
|
||||
x y pixel w 1- for color over l! 4 + next drop ;
|
||||
|
||||
: box { left top w h }
|
||||
left w + top h + { right bottom }
|
||||
left 0 max to left
|
||||
top 0 max to top
|
||||
right width min to right
|
||||
bottom height min to bottom
|
||||
left right >= top bottom >= if exit then
|
||||
right left - to w
|
||||
bottom top - to h
|
||||
top h 1- for left over w hline 1+ next
|
||||
;
|
||||
|
||||
0 value clicking
|
||||
|
||||
640 480 window
|
||||
: run
|
||||
begin
|
||||
wait
|
||||
100 0 do
|
||||
50 0 do
|
||||
$ffcc00 i j pixel l!
|
||||
loop
|
||||
loop
|
||||
PRESSED event = if 1 to clicking then
|
||||
RELEASED event = if 0 to clicking then
|
||||
0 to color
|
||||
0 0 width height box
|
||||
clicking if $00ccff else $ffcc00 then to color
|
||||
mouse-x 100 - mouse-y 50 - 200 100 box
|
||||
flip
|
||||
event FINISHED = until
|
||||
bye
|
||||
|
||||
@ -38,7 +38,7 @@ cell allocate throw to backbuffer
|
||||
binfo BITMAPINFO erase
|
||||
BITMAPINFOHEADER binfo ->bmiHeader ->biSize !
|
||||
w binfo ->bmiHeader ->biWidth !
|
||||
h binfo ->bmiHeader ->biHeight !
|
||||
h negate binfo ->bmiHeader ->biHeight !
|
||||
1 binfo ->bmiHeader ->biPlanes !
|
||||
32 binfo ->bmiHeader ->biBitCount !
|
||||
BI_RGB binfo ->bmiHeader ->biCompression !
|
||||
@ -66,13 +66,9 @@ cell allocate throw to backbuffer
|
||||
0 exit
|
||||
then
|
||||
WM_KEYDOWN msg = if
|
||||
l GET_X_LPARAM to mouse-x
|
||||
l GET_Y_LPARAM to mouse-y
|
||||
PRESSED to event
|
||||
then
|
||||
WM_KEYUP msg = if
|
||||
l GET_X_LPARAM to mouse-x
|
||||
l GET_Y_LPARAM to mouse-y
|
||||
RELEASED to event
|
||||
then
|
||||
WM_CHAR msg = if
|
||||
@ -91,6 +87,7 @@ cell allocate throw to backbuffer
|
||||
l GET_X_LPARAM to mouse-x
|
||||
l GET_Y_LPARAM to mouse-y
|
||||
MOTION to event
|
||||
0 exit
|
||||
then
|
||||
hwnd msg w l DefWindowProcA
|
||||
;
|
||||
@ -100,6 +97,9 @@ also internals
|
||||
also windows
|
||||
|
||||
: window { width height }
|
||||
width 0< { fullscreen }
|
||||
fullscreen if 640 to width 480 to height then
|
||||
|
||||
NULL GetModuleHandleA to hinstance
|
||||
1 1 rescale
|
||||
|
||||
@ -118,7 +118,8 @@ also windows
|
||||
|
||||
hwnd GetDC to hdc
|
||||
|
||||
hwnd SW_SHOWMAXIMIZED ShowWindow drop
|
||||
fullscreen if SW_SHOWMAXIMIZED else SW_SHOWDEFAULT then
|
||||
hwnd swap ShowWindow drop
|
||||
hwnd SetForegroundWindow drop
|
||||
;
|
||||
|
||||
|
||||
Reference in New Issue
Block a user