picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

rcsim.l (19897B)


      1 # 15apr13abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 ### RC Flight Simulator for 64-bit PicoLisp ###
      5 
      6 # *FocLen *Scene *Model
      7 # *DT *Throttle *Speed *Altitude
      8 
      9 (scl 6)  # Keep in sync with `SCL' in C lib
     10 
     11 (load "@lib/z3d.l" "@lib/term.l")
     12 
     13 # Color Constant Definitions from "/usr/lib/X11/rgb.txt"
     14 (def 'Black     (hex "000000"))
     15 (def 'Blue      (hex "0000FF"))
     16 (def 'Brown     (hex "A52A2A"))
     17 (def 'DarkGreen (hex "006400"))
     18 (def 'DarkGrey  (hex "A9A9A9"))
     19 (def 'Grey      (hex "BEBEBE"))
     20 (def 'LightBlue (hex "ADD8E6"))
     21 (def 'Red       (hex "FF0000"))
     22 (def 'Yellow    (hex "FFFF00"))
     23 (def 'White     (hex "FFFFFF"))
     24 
     25 # Create model
     26 (de model (Obj Lst Pos)
     27    (default Pos `(* 8 12))
     28    (apply struct
     29       (conc
     30          (extract                                        # Faces
     31             '((M)
     32                (unless (and (car M) (sym? @))
     33                   (inc 'Pos 8)
     34                   (cons
     35                      (struct
     36                         (native "@" "malloc" 'N
     37                            (+ `(* 4 4) (* 8 (length (cddr M)))) )
     38                         'N
     39                         (cons (or (num? (car M)) `(hex "1000000")) 4)
     40                         (cons
     41                            (or
     42                               (num? (cadr M))
     43                               (if (cadr M)
     44                                  `(hex "2000000")
     45                                  `(hex "1000000") ) )
     46                            4 )
     47                         (- (/ (length (cddr M)) 3))
     48                         -42
     49                         (cons 1.0 (cddr M)) )
     50                      8 ) ) )
     51             (cddddr Lst) )
     52          (cons (0 . 8))
     53          (extract                                        # Submodels
     54             '((M)
     55                (when (and (car M) (sym? @))
     56                   (inc 'Pos 8)
     57                   (cons
     58                      (if (cdr M)
     59                         (model Obj M Pos)
     60                         (put Obj (car M) Pos)
     61                         0 )
     62                      8 ) ) )
     63             (cddddr Lst) )
     64          '((0 . 8)) )
     65       (put Obj (pop 'Lst)
     66          (native "@" "malloc" 'N
     67             (+ `(* 8 12) (* 8 (length (cdr Lst)))) ) )   # (+ 2 CDDDR)
     68       'N                                                 # Return structure pointer
     69       (cons 1.0 (head 3 Lst))                            # pos
     70       (1.0  1.0 0.0 0.0  0.0 1.0 0.0  0.0 0.0 1.0) ) )   # rot
     71 
     72 # Simulation
     73 (de *DT . 0.020)
     74 (de *Tower . 12.0)
     75 
     76 (de MUL Args
     77    (let D 1.0
     78       (make
     79          (link '*/ (pop 'Args) (pop 'Args))
     80          (while Args
     81             (setq D (* D 1.0))
     82             (link (pop 'Args)) )
     83          (link D) ) ) )
     84 
     85 (de damp ("Var" Val)
     86    (set "Var" (>> 1 (+ Val (val "Var")))) )
     87 
     88 (class +Model)
     89 # mass power rc lc tx tz pitch torq stab
     90 # body leftAileron rightAileron rudder elevator propeller blade disk
     91 # ele ail rud thr thrust vx vy vz fx fy fz dx dy dz
     92 
     93 (dm T ()
     94    (=: mass 910.0)               # kg
     95    (=: power 3924.0)             # N
     96    (=: rc -1.4)                  # kg/m
     97    (=: lc -250.0)                # kg/m
     98    (=: trim 30)                  # Trimmung
     99    (=: lim1 0.8)                 # tan(a)
    100    (=: lim2 0.24)
    101    (=: tx 1.2)                   # Touchdown
    102    (=: tz -1.9)
    103    (=: pitch 0.26)
    104    (=: torq -10000.0)            # Drehmoment
    105    (=: stab (0.01 0.01 0.02))    # Stabilitaet
    106    (model This
    107       '(body 0.0 0.0 1.50
    108          # Flaeche oben
    109          (`Blue `Blue -0.15 +0.30 +1.05  +1.20  0.00 +1.05  +1.20 +3.90 +1.05  +0.90 +4.20 +1.05  -0.20 +3.90 +1.05  -0.60 +2.20 +1.05  -0.60 +0.60 +1.05)
    110          (`Blue `Blue -0.60 -0.60 +1.05  -0.60 -2.20 +1.05  -0.20 -3.90 +1.05  +0.90 -4.20 +1.05  +1.20 -3.90 +1.05  +1.20  0.00 +1.05  -0.15 -0.30 +1.05)
    111          (`Blue `Blue +1.20  0.00 +1.05  -0.15 -0.30 +1.05  -0.15 +0.30 +1.05)
    112          # Querruder
    113          (rightAileron -0.60 +2.20 +1.05
    114             (`Red `Red +0.40 +1.70  0.00  +0.72 +1.78 0.00  +0.72 +1.90 0.00  +0.40 +2.10 0.00  0.00 +1.80 0.00  0.00 +1.70 0.00)
    115             (`Red `Red +0.40 +1.70  0.00   0.00 +1.70 0.00   0.00  0.00 0.00) )
    116          (leftAileron -0.60 -2.20 +1.05
    117             (`Red `Red +0.40 -1.70 0.00  +0.72 -1.78 0.00  +0.72 -1.90 0.00  +0.40 -2.10 0.00  0.00 -1.80 0.00  0.00 -1.70 0.00)
    118             (`Red `Red +0.40 -1.70 0.00   0.00 -1.70 0.00   0.00  0.00 0.00) )
    119          # Flaeche rechts unten
    120          (`Blue `Blue +0.90 +0.20 -0.60  +0.90 +3.90 -0.30  +0.60 +4.20 -0.30  -0.90 +3.90 -0.30  -0.90 +0.20 -0.60)
    121          # Flaeche links unten
    122          (`Blue `Blue -0.90 -0.20 -0.60  -0.90 -3.90 -0.30  +0.60 -4.20 -0.30  +0.90 -3.90 -0.30  +0.90 -0.20 -0.60)
    123          # Streben links
    124          (`Brown `Brown -0.20 -2.55 +1.05  -0.50 -2.55 -0.37  -0.60 -2.55 -0.37  -0.30 -2.55 +1.05)
    125          (`Brown `Brown -0.50 -2.55 -0.37  -0.50 -2.55 -0.37  +0.80 -2.55 +0.90  +0.80 -2.55 +1.05)
    126          (`Brown `Brown +0.90 -2.55 +1.05  +0.60 -2.55 -0.37  +0.50 -2.55 -0.37  +0.80 -2.55 +1.05)
    127          # Streben rechts
    128          (`Brown `Brown -0.20 +2.55 +1.05  -0.50 +2.55 -0.37  -0.60 +2.55 -0.37  -0.30 +2.55 +1.05)
    129          (`Brown `Brown -0.50 +2.55 -0.37  -0.50 +2.55 -0.37  +0.80 +2.55 +0.90  +0.80 +2.55 +1.05)
    130          (`Brown `Brown +0.90 +2.55 +1.05  +0.60 +2.55 -0.37  +0.50 +2.55 -0.37  +0.80 +2.55 +1.05)
    131          # Motorlager
    132          (`Grey NIL +1.80 +0.30 +0.30  +1.80 -0.30 +0.30  +1.80 -0.30 -0.30  +1.80 +0.30 -0.30)
    133          # Rumpfnase
    134          (`Blue NIL +1.20  0.00 +0.60  +1.80 -0.30 +0.30  +1.80 +0.30 +0.30)
    135          (`Blue NIL +1.20  0.00 +0.60  +1.20 -0.45 +0.30  +1.80 -0.30 +0.30)
    136          (`Blue NIL +1.80 +0.30 +0.30  +1.20 +0.45 +0.30  +1.20  0.00 +0.60)
    137          (`Blue NIL +1.20 -0.45 +0.30  +1.20 -0.45 -0.30  +1.80 -0.30 -0.30  +1.80 -0.30 +0.30)
    138          (`Blue NIL +1.80 +0.30 +0.30  +1.80 +0.30 -0.30  +1.20 +0.45 -0.30  +1.20 +0.45 +0.30)
    139          (`Blue NIL +1.20 -0.45 -0.30  +1.20 -0.30 -0.60  +1.80 -0.30 -0.30)
    140          (`Blue NIL +1.80 +0.30 -0.30  +1.20 +0.30 -0.60  +1.20 +0.45 -0.30)
    141          (`Blue NIL +1.20 -0.30 -0.60  +1.20 +0.30 -0.60  +1.80 +0.30 -0.30  +1.80 -0.30 -0.30)
    142          # Rumpfseite rechts
    143          (`Red NIL +1.20 +0.45 +0.30  +1.20 +0.45 -0.30  -1.50 +0.45 -0.30  -1.50 +0.45 +0.30  -1.20 +0.45 +0.45  -0.90 +0.45 +0.45)
    144          (`Red NIL -1.50 +0.45 +0.30  -1.50 +0.45 -0.30  -4.80  0.00 -0.30 -4.80   0.00  0.00)
    145          # Rumpfseite links
    146          (`Red NIL -0.90 -0.45 +0.45  -1.20 -0.45 +0.45  -1.50 -0.45 +0.30  -1.50 -0.45 -0.30  +1.20 -0.45 -0.30  +1.20 -0.45 +0.30)
    147          (`Red NIL -4.80  0.00  0.00  -4.80  0.00 -0.30  -1.50 -0.45 -0.30  -1.50 -0.45 +0.30)
    148          # Rumpfoberteil vorne
    149          (`Red NIL +1.20 0.00 +0.60  +1.20 +0.45 +0.30  -0.90 +0.45 +0.45  -0.60 0.00 +0.60)
    150          (`Red NIL -0.60 0.00 +0.60  -0.90 -0.45 +0.45  +1.20 -0.45 +0.30  +1.20 0.00 +0.60)
    151          # Cockpit
    152          (`Brown NIL -0.60  0.00 +0.60  -0.90 +0.45 +0.45  -0.90 -0.45 +0.45)
    153          (`Black NIL -0.90 +0.45 +0.45  -1.20 +0.45 +0.45  -1.20 -0.45 +0.45  -0.90  -0.45  +0.45)
    154          (`Black NIL -1.20 +0.45 +0.45  -1.35  0.00 +0.54  -1.20 -0.45 +0.45)
    155          # Rumpfoberteil hinten
    156          (`Red NIL -1.35  0.00 +0.54  -1.20 +0.45 +0.45  -4.80  0.00  0.00)
    157          (`Red NIL -1.20 +0.45 +0.45  -1.50 +0.45 +0.30  -4.80  0.00  0.00)
    158          (`Red NIL -4.80  0.00  0.00  -1.20 -0.45 +0.45  -1.35  0.00 +0.54)
    159          (`Red NIL -4.80  0.00  0.00  -1.50 -0.45 +0.30  -1.20 -0.45 +0.45)
    160          # Rumpfboden
    161          (`Red NIL +1.20 +0.45 -0.30  +1.20 +0.30 -0.60  -1.50 +0.30 -0.60  -1.50 +0.45 -0.30)
    162          (`Red NIL +1.20 +0.30 -0.60  +1.20 -0.30 -0.60  -1.50 -0.30 -0.60  -1.50 +0.30 -0.60)
    163          (`Red NIL -1.50 -0.45 -0.30  -1.50 -0.30 -0.60  +1.20 -0.30 -0.60  +1.20 -0.45 -0.30)
    164          (`Red NIL -4.80  0.00 -0.30  -1.50 -0.30 -0.60  -1.50 -0.45 -0.30)
    165          (`Red NIL -4.80  0.00 -0.30  -1.50 +0.30 -0.60  -1.50 -0.30 -0.60)
    166          (`Red NIL -1.50 +0.45 -0.30  -1.50 +0.30 -0.60  -4.80  0.00 -0.30)
    167          # Hoehenleitwerk
    168          (`Red `Red -3.60 +0.15 0.00  -4.20 +1.80 0.00  -4.50 +1.80 0.00  -4.50 +0.06 0.00)
    169          (`Red `Red -4.50 -0.06 0.00  -4.50 -1.80 0.00  -4.20 -1.80 0.00  -3.60 -0.15 0.00)
    170          # Hoehenruder
    171          (elevator -4.50 0.00 0.00
    172             (`Blue `Blue 0.00 +1.80 0.00  -0.60 +1.50 0.00  -0.60 +0.60 0.00  0.00 +0.06 0.00)
    173             (`Blue `Blue 0.00 -0.06 0.00  -0.60 -0.60 0.00  -0.60 -1.50 0.00  0.00 -1.80 0.00) )
    174          # Seitenleitwerk
    175          (`Red `Red -4.80 0.00 0.00  -3.60 0.00 +0.15  -4.20 0.00 +0.90  -4.80 0.00 +1.05)
    176          # Seitenruder
    177          (rudder -4.80 0.00 0.00
    178             (`Blue `Blue 0.00 0.00 +1.05  0.00 0.00 -0.30  -0.45 0.00 +0.30  -0.45 0.00 +0.90) )
    179          # Schatten Nase
    180          (NIL T +0.90 -0.30 -0.20  +1.70 0.00 -0.20  +0.90 +0.30 -0.20)
    181          # Schatten Flaechen
    182          (NIL T +0.90 -3.00 -0.20  +0.90 +3.00 -0.20  -0.90 +3.00 -0.20  -0.90 -3.00 -0.20)
    183          # Schatten Rumpf
    184          (NIL T -0.90 -0.40 -0.20  -0.90 +0.40 -0.20  -4.70 0.00 -0.20)
    185          # Schatten Leitwerk
    186          (NIL T -3.60 0.00 -0.20  -4.20 +1.80 -0.20  -4.50 +1.80 -0.20  -4.50 -1.80 -0.20  -4.20 -1.80 -0.20)
    187          # Spinner
    188          (`Blue NIL +1.80 +0.15 -0.15  +1.80 +0.15 +0.15  +2.10 0.00 0.00)
    189          (`Blue NIL +1.80 -0.15 -0.15  +1.80 +0.15 -0.15  +2.10 0.00 0.00)
    190          (`Blue NIL +1.80 -0.15 +0.15  +1.80 -0.15 -0.15  +2.10 0.00 0.00)
    191          (`Blue NIL +1.80 +0.15 +0.15  +1.80 -0.15 +0.15  +2.10 0.00 0.00)
    192          # Fahrwerk
    193          (`Grey `Grey +1.20 +0.30 -0.60  +1.20 +0.90 -1.47  +1.20 +1.00 -1.47  +1.20 +0.40 -0.60)
    194          (`Grey `Grey +1.20 -0.30 -0.60  +1.20 -0.90 -1.47  +1.20 -1.00 -1.47  +1.20 -0.40 -0.60)
    195          (`Grey `Grey +1.20 -1.20 -1.47  +1.20 -1.20 -1.53  +1.20 +1.20 -1.53  +1.20 +1.20 -1.47)
    196          (`Grey `Grey +1.20 +0.90 -1.53  +1.20 +0.90 -1.47  +0.30 +0.30 -0.60  +0.18 +0.30 -0.60)
    197          (`Grey `Grey +1.20 -0.90 -1.53  +1.20 -0.90 -1.47  +0.30 -0.30 -0.60  +0.18 -0.30 -0.60)
    198          # Rad rechts
    199          (`Yellow `Yellow +1.20 +1.20 -1.20  +1.38 +1.20 -1.25  +1.50 +1.20 -1.37  +1.55 +1.20 -1.55  +1.50 +1.20 -1.73  +1.38 +1.20 -1.85  +1.20 +1.20 -1.90  +1.02 +1.20 -1.85  +0.90 +1.20 -1.72  +0.85 +1.20 -1.55  +0.90 +1.20 -1.37  +1.02 +1.20 -1.25)
    200          # Schatten Rad rechts
    201          (NIL T +1.60 +1.00 -1.55  +1.60 +1.40 -1.55  +0.80 +1.40 -1.55  +0.80 +1.00 -1.55)
    202          # Rad links
    203          (`Yellow `Yellow +1.20 -1.20 -1.20  +1.38 -1.20 -1.25  +1.50 -1.20 -1.37  +1.55 -1.20 -1.55  +1.50 -1.20 -1.73  +1.38 -1.20 -1.85  +1.20 -1.20 -1.90  +1.02 -1.20 -1.85  +0.90 -1.20 -1.72  +0.85 -1.20 -1.55  +0.90 -1.20 -1.37  +1.02 -1.20 -1.25)
    204          # Schatten Rad links
    205          (NIL T +1.60 -1.00 -1.55  +1.60 -1.40 -1.55  +0.80 -1.40 -1.55  +0.80 -1.00 -1.55)
    206          # Platzhalter
    207          (propeller) ) )
    208    (model This
    209       '(blade +1.95 0.00 0.00
    210          (`Black `Black -0.05 0.00 0.00  +0.05 0.00 0.00  +0.02 +0.40 -0.50  +0.00 +0.90 -0.90  -0.02 +0.50 -0.40  -0.05 0.00 0.00  -0.02 -0.50 +0.40  +0.00 -0.90 +0.90  +0.02 -0.40 +0.50  +0.05 0.00 0.00) ) )
    211    (model This
    212       '(disk +1.95 0.00 0.00
    213          (NIL NIL +0.00 -0.30 +1.20  +0.00 -0.90 +0.90  +0.00 -1.20 +0.30  +0.00 -1.20 -0.30  +0.00 -0.90 -0.90  +0.00 -0.30 -1.20  +0.00 +0.30 -1.20  +0.00 +0.90 -0.90  +0.00 +1.20 -0.30  +0.00 +1.20 +0.30  +0.00 +0.90 +0.90  +0.00 +0.30 +1.20) ) )
    214    (=: ele (=: ail (=: rud (=: thr (=: thrust 0)))))
    215    (=: vx (=: vy (=: vz 0)))
    216    (=: fx (=: fy (=: fz 0)))
    217    (=: dx (=: dy (=: dz 0)))
    218    (z3dDX (: body) -100.0)
    219    (z3dDY (: body) -200.0)
    220    (z3dYrot (: body) 0.26)
    221    (inc (:: propeller) (: body))
    222    (=: blade (cons (: blade) 8))
    223    (=: disk (cons (: disk) 8))
    224    (struct (: propeller) NIL (: blade)) )
    225 
    226 (dm dir> (VarX VarY)
    227    (let B (struct (: body) (1.0 . 3))
    228       (z3dSpot VarX VarY
    229          (+ (car B) (>> 3 (: vx)) (>> 2 (: vz)))
    230          (+ (cadr B) (>> 3 (: vy)) (>> 2 (: vz)))
    231          (-
    232             (+ (caddr B) (>> 3 (: vz)) (>> 2 (: vz)))
    233             *Tower ) ) ) )
    234 
    235 (dm down> ()
    236    (when (> (: ele) -100)
    237       (dec (:: ele) 20)
    238       (z3dArot (: elevator) +0.2) ) )
    239 
    240 (dm up> ()
    241    (when (> 100 (: ele))
    242       (inc (:: ele) 20)
    243       (z3dArot (: elevator) -0.2) ) )
    244 
    245 (dm left> ()
    246    (when (> (: ail) -100)
    247       (dec (:: ail) 20)
    248       (dec (:: rud) 20)
    249       (z3dArot (: leftAileron) +0.2)
    250       (z3dArot (: rightAileron) +0.2)
    251       (z3dArot (: rudder) +0.2) ) )
    252 
    253 (dm right> ()
    254    (when (> 100 (: ail))
    255       (inc (:: ail) 20)
    256       (inc (:: rud) 20)
    257       (z3dArot (: leftAileron) -0.2)
    258       (z3dArot (: rightAileron) -0.2)
    259       (z3dArot (: rudder) -0.2) ) )
    260 
    261 (dm throt> (X)
    262    (=: thr
    263       (cond
    264          ((not X) 0)
    265          ((=T X) 100)
    266          ((lt0 X) (max 10 (- (: thr) 25)))
    267          ((=0 (: thr)) 10)
    268          ((= 10 (: thr)) 25)
    269          (T (min 100 (+ 25 (: thr)))) ) ) )
    270 
    271 (dm sim> ()
    272    (cond
    273       ((gt0 (: ele))
    274          (dec (:: ele))
    275          (z3dArot (: elevator) +0.01) )
    276       ((lt0 (: ele))
    277          (inc (:: ele))
    278          (z3dArot (: elevator) -0.01) ) )
    279    (cond
    280       ((gt0 (: ail))
    281          (dec (:: ail))
    282          (dec (:: rud))
    283          (z3dArot (: leftAileron) +0.01)
    284          (z3dArot (: rightAileron) +0.01)
    285          (z3dArot (: rudder) +0.01) )
    286       ((lt0 (: ail))
    287          (inc (:: ail))
    288          (inc (:: rud))
    289          (z3dArot (: leftAileron) -0.01)
    290          (z3dArot (: rightAileron) -0.01)
    291          (z3dArot (: rudder) -0.01) ) )
    292    (cond
    293       ((> (: thr) (: thrust))
    294          (inc (:: thrust)) )
    295       ((> (: thrust) (: thr))
    296          (dec (:: thrust)) ) )
    297    (struct (: propeller) NIL
    298       (if (> 20 (: thrust))
    299          (: blade)
    300          (: disk) ) )
    301    (unless (=0 (: thrust))
    302       (z3dXrot
    303          (if (> 20 (: thrust))
    304             (: blade 1)
    305             (: disk 1) )
    306          0.2 ) )
    307    (use (Touch VX VY VZ Body Taxi Stick A FX FY FZ DX DY DZ)
    308       (z3dRotate (: body) (: tx) 0 (: tz) NIL NIL 'Touch)
    309       (z3dRotate (: body) (: vx) (: vy) (: vz) 'VX 'VY 'VZ T)
    310       (setq
    311          Body (struct (: body) (1.0 . 12))
    312          Taxi (> 0.1 (+ (caddr Body) Touch))
    313          Stick (>= 1.0 (+ VX VY))
    314          FX (+ (*/ (: thrust) (: power) 100) `(MUL (: rc) VX (abs VX)))
    315          FZ (+
    316             (cond
    317                ((> 0.1 VX) 0)
    318                ((> (abs (setq A (*/ 1.0 VZ VX))) (: lim2))
    319                   0 )
    320                ((>= (: lim1) A)
    321                   `(MUL VX VX (: lc) A) )
    322                (T `(MUL VX VX (: lc) (- (: lim2) A))) )
    323             `(MUL 8.0 (: rc) VZ (abs VZ)) ) )
    324       (ifn Taxi
    325          (setq FY `(MUL 4.0 (: rc) VY (abs VY)))
    326          (let F (>> 2 (: mass))
    327             (cond
    328                ((> 0.1 (abs VX))
    329                   (and (>= F FX) (zero FX)) )
    330                ((gt0 VX)
    331                   (dec 'FX F) )
    332                (T (inc 'FX F)) )
    333             (setq FY (if (lt0 VY) (* 12 F) (* -12 F))) )
    334          (z3dYrot (: body)
    335             (>> 3 (- (: pitch) (get Body 6))) ) )  # rot.a.z
    336       (unless Stick
    337          (z3dYrot (: body)
    338             (+
    339                (*/ VX (+ (: ele) (: trim)) 80000)
    340                `(MUL VZ (: stab 2)) ) )
    341          (if Taxi
    342             (prog
    343                (z3dZrot (: body) (*/ VX (: rud) 80000))
    344                (z3dXrot (: body) (get Body 9)) )  # rot.b.z
    345             (z3dXrot (: body)  # roll
    346                (+
    347                   (- (*/ VX (: ail) 80000) (/ VY 400))
    348                   (*/ (: thrust) (: torq) (: mass))
    349                   `(MUL (get Body 9) (: stab 1)) ) )  # rot.b.z
    350             (z3dZrot (: body)
    351                (+
    352                   (*/ VX (: rud) 80000)
    353                   `(MUL VY (: stab 3)) ) ) ) )
    354       # World system
    355       (z3dRotate (: body) FX FY FZ 'FX 'FY 'FZ)
    356       (dec 'FZ `(MUL (: mass) 9.81))
    357       # Accelerate
    358       (setq
    359          A (*/ 1.0 *DT (: mass))
    360          DX `(MUL A (damp (:: fx) FX))
    361          DY `(MUL A (damp (:: fy) FY))
    362          DZ `(MUL A (damp (:: fz) FZ)) )
    363       (if (and Stick (> 0.001 (+ `(MUL DX DX) `(MUL DY DY))))
    364          (=: vx (=: vy (=: dx (=: dy 0))))
    365          (inc (:: vx) (damp (:: dx) DX))
    366          (inc (:: vy) (damp (:: dy) DY)) )
    367       (inc (:: vz) (damp (:: dz) DZ))
    368       (when (and Taxi (lt0 (: vz)))
    369          (when (> -6.0 (: vz))
    370             (=: thr (=: thrust 0))
    371             (=: vx (=: vy 0))
    372             (struct (: propeller) NIL (: blade)) )
    373          (z3dZ (: body) (- Touch))
    374          (=: vz 0) )
    375       # Translate
    376       (z3dDX (: body) `(MUL (: vx) *DT))
    377       (z3dDY (: body) `(MUL (: vy) *DT))
    378       (z3dDZ (: body) `(MUL (: vz) *DT))
    379       # Instruments
    380       (setq
    381          *Throttle (: thr)
    382          *Speed (*/ VX 3.6 `(* 1.0 1.0))
    383          *Altitude (/ (caddr Body) 1.0) ) ) )
    384 
    385 (dm draw> ()
    386    (z3dDraw (: body)) )
    387 
    388 # Scene
    389 (class +Scene)
    390 # env
    391 
    392 (dm T ()
    393    (model This
    394       '(runway1 -120.0 -200.0 -0.02
    395          (`DarkGrey NIL +20.0 -20.0 0  +20.0 +20.0 0  -20.0 +20.0 0  -20.0 -20.0 0)
    396          (`White NIL +10.0 -1.0 0  +10.0 +1.0 0  -10.0 +1.0 0  -10.0 -1.0 0) ) )
    397    (model This
    398       '(runway2 -80.0 -200.0 -0.02
    399          (`DarkGrey NIL +20.0 -20.0 0  +20.0 +20.0 0  -20.0 +20.0 0  -20.0 -20.0 0)
    400          (`White NIL +10.0 -1.0 0  +10.0 +1.0 0  -10.0 +1.0 0  -10.0 -1.0 0) ) )
    401    (model This
    402       '(runway3 -40.0 -200.0 -0.02
    403          (`DarkGrey NIL +20.0 -20.0 0  +20.0 +20.0 0  -20.0 +20.0 0  -20.0 -20.0 0)
    404          (`White NIL +10.0 -1.0 0  +10.0 +1.0 0  -10.0 +1.0 0  -10.0 -1.0 0) ) )
    405    (model This
    406       '(runway4 0.0 -200.0 -0.02
    407          (`DarkGrey NIL +20.0 -20.0 0  +20.0 +20.0 0  -20.0 +20.0 0  -20.0 -20.0 0)
    408          (`White NIL +10.0 -1.0 0  +10.0 +1.0 0  -10.0 +1.0 0  -10.0 -1.0 0) ) )
    409    (model This
    410       '(runway5 +40.0 -200.0 -0.02
    411          (`DarkGrey NIL +20.0 -20.0 0  +20.0 +20.0 0  -20.0 +20.0 0  -20.0 -20.0 0)
    412          (`White NIL +10.0 -1.0 0  +10.0 +1.0 0  -10.0 +1.0 0  -10.0 -1.0 0) ) )
    413    (model This
    414       '(runway6 +80.0 -200.0 -0.02
    415          (`DarkGrey NIL +20.0 -20.0 0  +20.0 +20.0 0  -20.0 +20.0 0  -20.0 -20.0 0)
    416          (`White NIL +10.0 -1.0 0  +10.0 +1.0 0  -10.0 +1.0 0  -10.0 -1.0 0) ) )
    417    (model This
    418       '(runway7 +120.0 -200.0 -0.02
    419          (`DarkGrey NIL +20.0 -20.0 0  +20.0 +20.0 0  -20.0 +20.0 0  -20.0 -20.0 0)
    420          (`White NIL +10.0 -1.0 0  +10.0 +1.0 0  -10.0 +1.0 0  -10.0 -1.0 0) ) )
    421    (=: env
    422       (list
    423          (: runway1)
    424          (: runway2)
    425          (: runway3)
    426          (: runway4)
    427          (: runway5)
    428          (: runway6)
    429          (: runway7) ) ) )
    430 
    431 (dm sim> ())
    432 
    433 (dm draw> ()
    434    (mapc z3dDraw (: env)) )
    435 
    436 # Key Controls
    437 (fkey *XtIns   (and (> 32000.0 *FocLen) (setq *FocLen (>> -1 *FocLen))))
    438 (fkey *XtDel   (and (> *FocLen 2000.0) (setq *FocLen (>> 1 *FocLen))))
    439 (fkey *XtUp    (down> *Model))
    440 (fkey *XtDown  (up> *Model))
    441 (fkey *XtLeft  (left> *Model))
    442 (fkey *XtRight (right> *Model))
    443 (fkey *XtHome  (throt> *Model T))
    444 (fkey *XtPgDn  (throt> *Model -1))
    445 (fkey *XtPgUp  (throt> *Model +1))
    446 (fkey *XtEnd   (throt> *Model))
    447 
    448 # Init/Run
    449 (de main ()
    450    (setq
    451       *FocLen 8000.0
    452       *Scene (new '(+Scene))
    453       *Model (new '(+Model)) ) )
    454 
    455 (de go ()
    456    (when (z3dWindow "RC Simulator" 800 600)
    457       (quit @) )
    458    (zero "MSec")
    459    (task `(*/ -1000 *DT 1.0) 0  # -Milliseconds
    460       (let R (assoc @ *Run)
    461          (sim> *Scene)
    462          (sim> *Model)
    463          (use (Yaw Pitch)
    464             (dir> *Model 'Yaw 'Pitch)
    465             (z3dCamera *FocLen Yaw Pitch  0 0 *Tower  LightBlue DarkGreen) )
    466          (draw> *Scene)
    467          (draw> *Model)
    468          (z3dPut)
    469          (z3dText 20 580 (pack *Throttle " %"))
    470          (z3dText 120 580 (pack *Speed " km/h"))
    471          (z3dText 220 580 (pack *Altitude " m"))
    472          (z3dText 320 580
    473             (case *FocLen
    474                (2000.0 "(--)")
    475                (4000.0 "(-)")
    476                (16000.0 "(+)")
    477                (32000.0 "(++)") ) )
    478          (z3dSync)
    479          (let M (*/ (usec) 1000)
    480             (setq "MSec"
    481                (- M
    482                   (set (cdr R)
    483                      (min -2 (- M "MSec" `(*/ 1000 *DT 1.0))) ) ) ) ) ) ) )
    484 
    485 # vi:et:ts=3:sw=3