LOOKUP HRFORTH  ( HGR page 1 reserved )
LOOKUP HR2FORTH ( HGR page 1 and 2 reserved )
OR NOT ?ABORT" Must run with HRFORTH."

SRC" PLASMA.4TH"
SRC" CONIO.4TH"
SRC" HGRLIB.4TH"
SRC" HGRFONT.4TH"
SRC" TURTLE.4TH"

: SHOW
  40 _TEXT DROP
  0 HGRMODE HGRDRAWBUF DROP
  280 192 [ LOOKUP LINESPANS ] LITERAL INITTURTLE
  3 HGRCOLOR
;

: MIX
  0 19 40 4 VIEWPORT
  $C053 C@ DROP
  280 160 [ LOOKUP LINESPANS ] LITERAL INITTURTLE
;

0 VARIABLE RECT.WIDTH
0 VARIABLE RECT.HEIGHT

: RECT ( x y width height  -- )
  RECT.HEIGHT !
  RECT.WIDTH  !
  PENUP MOVETO PENDOWN
  RECT.WIDTH  @ MOVE 90 TURN
  RECT.HEIGHT @ MOVE 90 TURN
  RECT.WIDTH  @ MOVE 90 TURN
  RECT.HEIGHT @ MOVE 90 TURN
;

: STARBURST ( size-in-36-increments -- )
  PENUP
  0 TURNTO
  MOVETO
  PENDOWN
  0 DO ( SIZE ON STACK )
    PENUP
    I 2 / MOVE
    PENDOWN
    0 MOVE
    108 TURN
  LOOP
;

5 VARIABLE MISSILE.XVELOCITY
1 VARIABLE MISSILE.YVELOCITY
0 VARIABLE MISSILE.XPOS
0 VARIABLE MISSILE.XOLD
0 VARIABLE MISSILE.YPOS
0 VARIABLE MISSILE.YOLD

: SHOOT ( COLOR XVELOCITY YVELOCITY -- )
  MISSILE.YVELOCITY !
  MISSILE.XVELOCITY !
  140 DUP MISSILE.XPOS ! MISSILE.XOLD !
  191 DUP MISSILE.YPOS ! MISSILE.YOLD !
  PENUP
  MISSILE.XPOS @ MISSILE.YPOS @ MOVETO
  PENDOWN
  3 HGRCOLOR
  BEGIN
    MISSILE.XOLD @ MISSILE.YOLD @ MOVETO
    PENUP
    MISSILE.XPOS @ DUP MISSILE.XOLD ! MISSILE.YPOS @ DUP MISSILE.YOLD ! MOVETO
    PENDOWN
    MISSILE.YVELOCITY @ 1- DUP MISSILE.YVELOCITY ! 0< IF
      HGRCOLOR ( COLOR STILL ON STACK )
      144 MISSILE.XPOS @ MISSILE.YPOS @ STARBURST
      144 MISSILE.XPOS @ MISSILE.YPOS @ STARBURST
      EXIT
    THEN
    MISSILE.XPOS @ MISSILE.XVELOCITY @ + DUP MISSILE.XPOS !
    MISSILE.YPOS @ MISSILE.YVELOCITY @ - DUP MISSILE.YPOS !
    MOVETO
    10 20 MISSILE.YVELOCITY @ - TONE
  AGAIN
;

: FIREWORKS
  BEGIN
    RAND 8 MOD
    DUP 0=  IF 1+ THEN ( CHECK FOR BLACK1: 0 )
    DUP 4 = IF 1+ THEN ( CHECK FOR BLACK2: 4 )
    RAND 10 MOD 5 - RAND 10 MOD 10 + SHOOT
  KEY? UNTIL
  KEY DROP
;

SHOW
10 12 " Happy New Year 2026!" HGRPUTSTR
5 HGRCOLOR
61 90 154 18 RECT
60 89 156 20 RECT
LOOKUP HGRXORHLIN LOOKUP HGRXORVLIN SETLINESPANS
FIREWORKS
TXTMODE
