#! /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. 
 
graphics 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 
 

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