extra/rlgl/demo/demo.factor

   1 ! Copyright (C) 2023 CapitalEx.
   2 ! See https:!factorcode.org/license.txt for BSD license.
   3 ! A port of https://github.com/raysan5/raylib/blob/master/examples/models/models_rlgl_solar_system.c
   4 USING: accessors classes.struct kernel math math.functions
   5 ranges raylib rlgl sequences combinators.extras ;
   6 IN: rlgl.demo
   7
   8 ! Some raylib combinators
   9 : with-drawing ( clear-color quot -- )
  10     swap begin-drawing clear-background
  11     call end-drawing ; inline
  12
  13 : with-matrix ( quot -- )
  14     rl-push-matrix call rl-pop-matrix ; inline
  15
  16 : while-window-open ( quot -- )
  17     [ window-should-close not ] swap while ; inline
  18
  19 : with-camera-3d ( camera quot -- )
  20     swap begin-mode-3d call end-mode-3d ; inline
  21
  22 CONSTANT:      screenWidth 800
  23 CONSTANT:     screenHeight 450
  24 CONSTANT:        sunRadius 4.0
  25 CONSTANT:      earthRadius 0.6
  26 CONSTANT: earthOrbitRadius 8.0
  27 CONSTANT:       moonRadius 0.16
  28 CONSTANT:  moonOrbitRadius 1.5
  29 CONSTANT:    rotationSpeed 0.2
  30
  31 :: draw-sphere-basic ( color -- )
  32     16 16 :> ( rings slices )
  33     rings 2 + slices 6 * * rl-check-render-batch-limit drop
  34
  35     RL_TRIANGLES rl-begin
  36         color [ r>> ] [ g>> ] [ b>> ] [ a>> ] quad rl-color4ub
  37         rings 2 + [0..b) slices [0..b) [| i j |
  38             270 180 rings 1 + / i * + deg>rad cos j 360 * slices / deg>rad sin *
  39             270 180 rings 1 + / i * + deg>rad sin
  40             270 180 rings 1 + / i * + deg>rad cos j 360 * slices / deg>rad cos *
  41                         rl-vertex3f
  42
  43             270 180 rings 1 + / i 1 + * + deg>rad cos j 1 + 360 * slices / deg>rad sin *
  44             270 180 rings 1 + / i 1 + * + deg>rad sin
  45             270 180 rings 1 + / i 1 + * + deg>rad cos j 1 + 360 * slices / deg>rad cos *
  46                         rl-vertex3f
  47
  48             270 180 rings 1 + / i 1 + * + deg>rad cos j 360 * slices / deg>rad sin *
  49             270 180 rings 1 + / i 1 + * + deg>rad sin
  50             270 180 rings 1 + / i 1 + * + deg>rad cos j 360 * slices / deg>rad cos *
  51                         rl-vertex3f
  52
  53             270 180 rings 1 + / i * + deg>rad cos j 360 * slices / deg>rad sin *
  54             270 180 rings 1 + / i * + deg>rad sin
  55             270 180 rings 1 + / i * + deg>rad cos j 360 * slices / deg>rad cos *
  56                         rl-vertex3f
  57
  58             270 180 rings 1 + / i * + deg>rad cos j 1 + 360 * slices / deg>rad sin *
  59             270 180 rings 1 + / i * + deg>rad sin
  60             270 180 rings 1 + / i * + deg>rad cos j 1 + 360 * slices / deg>rad cos *
  61                         rl-vertex3f
  62
  63             270 180 rings 1 + / i 1 + * + deg>rad cos j 1 + 360 * slices / deg>rad sin *
  64             270 180 rings 1 + / i 1 + * + deg>rad sin
  65             270 180 rings 1 + / i 1 + * + deg>rad cos j 1 + 360 * slices / deg>rad cos *
  66                         rl-vertex3f
  67         ] cartesian-each
  68     rl-end ;
  69
  70 : draw-sun ( scale -- )
  71     dup dup rl-scalef GOLD draw-sphere-basic ;
  72
  73 : draw-moon ( radius rotation orbit-radius orbit-rotation -- )
  74     0.0 1.0 0.0 rl-rotatef
  75         0.0 0.0 rl-translatef
  76     0.0 1.0 0.0 rl-rotatef
  77     dup dup rl-scalef
  78     LIGHTGRAY draw-sphere-basic ;
  79
  80 : draw-earth ( radius rotation -- )
  81     0.25 1.0 0.0 rl-rotatef dup dup rl-scalef
  82     BLUE draw-sphere-basic ;
  83
  84 : draw-earth-and-moon ( moonRadius       moonRotation
  85                         moonOrbitRadius  moonOrbitRotation
  86                         earthRadius      earthRotation
  87                         earthOrbitRadius earthOrbitRotation -- )
  88     0.0 1.0 0.0 rl-rotatef 0.0 0.0 rl-translatef
  89     [ draw-earth ] with-matrix draw-moon ;
  90
  91 : draw-solar-system ( moonRadius       moonRotation
  92                       moonOrbitRadius  moonOrbitRotation
  93                       earthRadius      earthRotation
  94                       earthOrbitRadius earthOrbitRotation
  95                       sunRadius -- )
  96     [ draw-sun ] [ draw-earth-and-moon ] [ with-matrix ] bi@ ;
  97
  98 :: main ( -- )
  99     screenWidth screenHeight "raylib [models] example - rlgl module usage with push/pop matrix transformations"
 100         init-window
 101
 102     Camera3D <struct>
 103             16.0 16.0 16.0 <Vector3> >>position
 104              0.0  0.0  0.0 <Vector3> >>target
 105              0.0  1.0  0.0 <Vector3> >>up
 106                       45.0           >>fovy
 107         CAMERA_PERSPECTIVE           >>projection
 108     :> camera
 109
 110     0.0 0.0 :> ( earthRotation! earthOrbitRotation! )
 111     0.0 0.0 :> ( moonRotation!  moonOrbitRotation!  )
 112
 113     60 set-target-fps [
 114         camera CAMERA_ORBITAL update-camera
 115
 116         5.0 rotationSpeed * earthRotation + earthRotation!
 117         365.0 360.0 / 5.0 rotationSpeed * * rotationSpeed * earthOrbitRotation + earthOrbitRotation!
 118         rotationSpeed 2.0 * moonRotation + moonRotation!
 119         rotationSpeed 8.0 * moonOrbitRotation + moonOrbitRotation!
 120
 121         RAYWHITE [
 122             camera [
 123                 moonRadius  moonRotation  moonOrbitRadius  moonOrbitRotation
 124                 earthRadius earthRotation earthOrbitRadius earthOrbitRotation
 125                 sunRadius   draw-solar-system
 126
 127                 0.0 0.0 0.0 <Vector3> earthOrbitRadius 1 0 0 <Vector3> 90.0 RED 0.5 fade
 128                     draw-circle-3d
 129
 130                 20 1.0 draw-grid
 131             ] with-camera-3d
 132
 133             "EARTH ORBITING AROUND THE SUN!" 400 10 20 MAROON draw-text
 134             "Using Factor!"                  400 40 20 GOLD   draw-text
 135             10 10 draw-fps
 136         ] with-drawing
 137     ] while-window-open
 138
 139     close-window ;
 140
 141 MAIN: main