Re-root site.

This commit is contained in:
Brad Nelson
2022-02-27 20:59:19 -08:00
parent a26786d7ef
commit fb47179999
131 changed files with 27 additions and 39 deletions

57
examples/boxes.fs Normal file
View File

@ -0,0 +1,57 @@
#! /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.
grf
-1 -1 window
$ff0000 constant red
$ffff00 constant yellow
$00ff00 constant green
$0000ff constant blue
$000000 constant black
$ffffff constant white
$cccccc constant gray
$777777 constant dark-gray
: run
begin
poll
IDLE event = if
black to color 0 0 width height box
g{
vertical-flip
640 480 viewport
gray to color
0 0 640 480 box
dark-gray to color
0 0 400 300 box
g{
mouse-x mouse-y screen>g translate
LEFT-BUTTON pressed? if
g{ -100 -100 translate red to color -50 -50 100 100 box }g
g{ 100 -100 translate yellow to color -50 -50 100 100 box }g
g{ -100 100 translate green to color -50 -50 100 100 box }g
g{ 100 100 translate blue to color -50 -50 100 100 box }g
then
g{ white to color -50 -50 100 100 box }g
}g
}g
flip
then
event FINISHED = until
bye
;
run

263
examples/heart_game.fs Executable file
View File

@ -0,0 +1,263 @@
#! /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.
grf also structures
640 480 window
1 31 lshift 1- constant max-random
0 value seed
: random ( n -- )
seed max-random */
seed 7127 + 7919 * max-random mod to seed
;
10000 constant entity-limit
struct EntityStruct
ptr field ->x
ptr field ->y
ptr field ->vx
ptr field ->vy
ptr field ->kind
ptr field ->radius
ptr field ->step
0 constant DEAD
1 constant HEART-GOAL
2 constant HEART-HIT
3 constant FIRE
4 constant SPARK
5 constant ARROW
create entity-array entity-limit EntityStruct * allot
: entity ( n -- a ) EntityStruct * entity-array + ;
0 value entity-count
: nix ( n -- )
entity entity-count 1- entity swap EntityStruct cmove
entity-count 1- to entity-count
;
: cleanup
0 begin dup entity-count < while
dup entity ->kind @ DEAD = if
dup nix
else
1+
then
repeat
;
: new ( -- n )
entity-count entity EntityStruct erase
entity-count dup 1+ to entity-count
;
create arrow-table
1 c, 1 c, 2 c, 2 c, 3 c, 3 c, 1 c, 1 c, 1 c, 1 c,
1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c,
1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c,
2 c, 3 c, 3 c, 3 c, 4 c, 4 c, 5 c, 5 c, 5 c, 5 c,
: arrow-- ( n -- ) 39 swap - arrow-table + c@ 100 * ;
: draw-one { e } e ->kind @ { kind }
HEART-GOAL kind = if
$ff0000 128 random dup 8 lshift + + to color
e ->x @ e ->y @ e ->radius @ heart
exit
then
HEART-HIT kind = if
$ffff00 256 random + to color
e ->x @ e ->y @ e ->radius @ heart
exit
then
FIRE kind = SPARK kind = or if
$ff7700 128 random 8 lshift + to color
e ->x @ 400 - e ->y @ 400 - 800 800 box
exit
then
ARROW kind = if
$ffff00 256 random + to color
39 for
e ->x @ e ->vx @ i 10 */ + i arrow-- 2/ -
e ->y @ e ->vy @ i 10 */ + i arrow-- 2/ -
i arrow-- dup box
next
exit
then
;
: volcano
240 for
$334400 i 100 240 */ + to color
32000 i 50 * - 5000 - 24000 i 100 * -
i 100 * 10000 + 100 box
next
0 to color
32000 4000 - 24000 3000 - 8000 3000 box
;
: draw
0 to color 0 0 width height box
g{
vertical-flip
100000 48000 viewport
$003300 to color 0 0 100000 48000 box
$0044cc to color 0 30000 100000 48000 box
volcano
entity-count 0 ?do i entity draw-one loop
}g
flip
;
: random-spark { e }
new entity { s }
SPARK s ->kind !
e ->x @ s ->x !
e ->y @ s ->y !
e ->vx @ 200 random 100 - + s ->vx !
e ->vy @ 200 random 200 - + s ->vy !
0 s ->step !
800 s ->radius !
;
: square ( n -- n2 ) dup * ;
: distance2 { e f }
e ->x @ f ->x @ - 100 / square
e ->y @ f ->y @ - 100 / square +
e ->radius @ f ->radius @ + 100 / square - ;
: tick-one { e }
-4 e ->vy +!
e ->vx @ e ->x @ + e ->x !
e ->vy @ e ->y @ + e ->y !
e ->y @ 0< if DEAD e ->kind ! then
e ->kind @ { kind }
ARROW kind = if
entity-count 0 ?do
e i entity distance2 0< if
i entity ->kind @
dup HEART-GOAL = if
0 i entity ->vx !
1000 i entity ->vy !
HEART-HIT i entity ->kind !
DEAD e ->kind !
then
dup FIRE = swap SPARK = or if
FIRE e ->kind !
then
then
loop
then
HEART-HIT kind = if
e ->y @ 76800 > if DEAD e ->kind ! then
then
HEART-GOAL kind = if
3 e ->vy +!
e ->y @ 76800 > if DEAD e ->kind ! then
then
FIRE kind = if
e random-spark
then
SPARK kind = if
1 e ->step +!
e ->step @ 10 > if DEAD e ->kind ! then
then
;
: tick entity-count 0 ?do i entity tick-one loop ;
: random-heart { e }
HEART-GOAL e ->kind !
50000 random 50000 + e ->x !
10000 random 1000 + e ->y !
200 random 100 - e ->vx !
300 random e ->vy !
40 random 40 + 100 * e ->radius !
;
: random-fire { e }
FIRE e ->kind !
32000 8000 random + 4000 - e ->x !
24000 1000 random + 2000 - e ->y !
200 random 100 - e ->vx !
200 random 300 + e ->vy !
800 e ->radius !
;
: random-arrow { e }
ARROW e ->kind !
64000 random e ->x !
48000 random e ->y !
200 random 100 - e ->vx !
200 random e ->vy !
800 e ->radius !
;
: mouse-direction ( -- x y ) mouse-x mouse-y screen>g ;
: shoot-arrow
new entity { e }
ARROW e ->kind !
0 e ->x !
0 e ->y !
g{
vertical-flip
64000 48000 viewport
g{
70 1 70 1 scale
mouse-direction e ->vy ! e ->vx !
}g
}g
;
: hearts-spew
2 for new entity random-heart next
;
: volcano-spew
3 for new entity random-fire next
;
: fire shoot-arrow ;
0 value last-tm
0 value next-tm
: run
begin
poll
PRESSED event = if
65 last-key = if
hearts-spew
then
LEFT-BUTTON last-key = if
fire
then
then
event IDLE = if
begin ms-ticks to next-tm next-tm last-tm - 10 < while 1 ms repeat
next-tm to last-tm
100 random 0= if volcano-spew then
300 random 0= if hearts-spew then
draw
tick
cleanup
then
FINISHED event = until
bye
;
run

45
examples/heart_graph.fs Normal file
View File

@ -0,0 +1,45 @@
#! /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.
grf
640 480 window
: run
begin
wait
0 to color 0 0 width height box
g{
vertical-flip
3200 3200 viewport
$ffcccc to color
1600 1600 2900 heart
g{
-5 -5 translate
$ffffff to color
32 for
i 100 * 0 10 3200 box
0 i 100 * 3200 10 box
next
$ff0000 to color
1600 0 10 3200 box
0 2400 3200 10 box
}g
}g
flip
FINISHED event = until
bye
;
run

34
examples/httpd_sample.fs Executable file
View File

@ -0,0 +1,34 @@
#! /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.
also httpd
: handle-index
s" text/html" ok-response r|
<html>
<body>Hi!</body>
</html>
| send ;
: handle1
." Got a request for: " path type cr
path s" /" str= if handle-index exit then
notfound-response
;
: run 8080 server
begin handleClient if handle1 then pause again ;
run

38
examples/min_grf.fs Normal file
View File

@ -0,0 +1,38 @@
#! /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.
grf
-1 -1 window
$ff0000 constant red
$ffff00 constant yellow
$000000 constant black
: draw
black to color 0 0 width height box
yellow to color 0 0 width 2/ height 2/ box
red to color mouse-x mouse-y width 10 / height 10 / box
flip
;
: run
begin
poll
IDLE event = if draw then
event FINISHED = until
bye
;
run