Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

BER Approach 18032020

Uploader:Mitgliedgrindstone
Datum/Zeit:18.03.2020 16:13:02
Hinweis: Dieser Quelltext ist Bestandteil des Projekts BER Approach, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
Warnung: Es steht bereits eine neuere Version des Quelltexts zur Verfügung. Die hier vorliegende alte Version könnte Fehler enthalten, die in der neuen Version vielleicht ausgebessert wurden.

#Include "vbcompat.bi"

Const pi As Double = Acos(0)*2
Const _2pi As Double = Acos(0)*4
Const NMft As Integer = 6076 '1 NM = 6076 ft


#Define IMG_OUTLINE 0
#Define IMG_FILLED 8
#Define IMG_LTGREEN 0
#Define IMG_RED 16
#Define IMG_CYAN 32
#Define IMG_YELLOW 48

#Define FS_ACCELERATINGFORTAKEOFF -3
#Define FS_CLEAREDFORTAKEOFF -2
#Define FS_SCHEDULED -1
#Define FS_FLYING 0
#Define FS_CLEAREDFORLANDING 1
#Define FS_LANDING_HEADINGTORUNWAY 2
#Define FS_LANDING_CLOSER5NM 3
#Define FS_LANDING_CLOSER1_5NM 4
#Define FS_LANDING_THRESHOLD 5
#Define FS_LANDING_TOUCHDOWN 6
#Define FS_REMOVE 7
#Define FS_RESCHEDULE 8
#Define FS_EXIT 9 '16
#Define FS_BADEXIT 10 '17

#Define FSA_NOAPPROACH -1
#Define FSA_ABOVERUNWAY -2

Dim Shared As ULong black = RGB(0,0,0), _
                    white = RGB(255,255,255), _
                 darkgrey = RGB(100,100,100), _
                  midgrey = RGB(128,128,128), _
                   ltgrey = RGB(200,200,200), _
                      red = RGB(255,0,0), _
                  darkred = RGB(128,0,0), _
                     tran = RGB(255,0,255), _
                  ltgreen = RGB(100,255,100), _
                    green = RGB(0,255,0), _
                darkgreen = RGB(0,128,0), _
                   yellow = RGB(255,255,100), _
               darkyellow = RGB(180,180,80), _
                     cyan = RGB(0,255,255)

Type tFlag
    pause : 1 As ULong
    setup : 1 As ULong
    restart : 1 As ULong
    resum : 1 As ULong
    fired : 1 As ULong
End Type
Dim Shared As tFlag flag 'global flags

Type tSetup
    lvlName As String
    maxPlanes As Integer
    newPlaneGap As Double
    helpturn : 2 As UByte
    helpdest : 2 As UByte
    helpmessage :3 As UByte
End Type
Dim Shared As tSetup lvl

Type tPolar
    r As Double
    phi As Double
End Type

Type tPosition
    x As Double
    y As Double
End Type

'basic arithmetic operations for tPosition
Operator + (p1 As tPosition, p2 As tPosition) As tPosition
    Return Type<tPosition>(p1.x + p2.x, p1.y + p2.y)
End Operator

Operator - (p1 As tPosition, p2 As tPosition) As tPosition
    Return Type<tPosition>(p1.x - p2.x, p1.y - p2.y)
End Operator

Operator * (p1 As tPosition, f As Double) As tPosition
    Return Type<tPosition>(p1.x * f, p1.y * f)
End Operator

Operator / (p1 As tPosition, f As Double) As tPosition
    Return Type<tPosition>(p1.x / f, p1.y / f)
End Operator

Operator = (p1 As tPosition, p2 As tPosition) As boolean
    If (p1.x = p2.x) AndAlso (p1.y = p2.y) Then
        Return TRUE
    Else
        Return FALSE
    EndIf
End Operator

Operator <> (p1 As tPosition, p2 As tPosition) As boolean
    Return IIf(p1 = p2, FALSE, TRUE)
End Operator


Type tMMcolors 'mouse menu colors
    foreground As ULong
    background As ULong
    frame As ULong
    foregroundhi As ULong
    backgroundhi As ULong
    framehi As ULong
    Declare Property text(col As ULong)
    Declare Property bgnd(col As ULong)
End Type

Property tMMcolors.text(col As ULong)
    this.foreground = col
    this.backgroundhi = col
    this.frame = col
    this.framehi = col
End Property

Property tMMcolors.bgnd(col As ULong)
    this.foregroundhi = col
    this.background = col
End Property

Enum
    _N   '360
    _NE  '045
    _E   '090
    _SE  '135
    _S   '180
    _SW  '225
    _W   '270
    _NW  '315
End Enum

Enum 'runway / slot types
    _bidir = 1
    _unidir
    _slot
End Enum


Dim Shared As Integer radar_sc, grid 'in pixels
Dim Shared As Double NMperGrid 'grid / NMperGrid = pixel/NM
Dim Shared As Double scale 'feet/pixel

                             '1 ft = 0.3048m
                             '1 NM = 1852m = 6076 ft
                             '1 kt = 6076 ft/h = 1.69 ft/s

Dim Shared As Any Ptr planeImg(&b00111111) 'array of image buffer pointers
'                                  |/||||__+45° clockwise (north = 0°)
'                                  | |||___+90°
'                                  | ||____+180°
'                                  | |_____0 = outline  1 = filled
'                                  |_______color: 00 = ltgreen  01 = red  10 = cyan  11 = yellow

Dim Shared As tPosition gridOffset(_N To _NW) 'array of grid offsets
Dim Shared As Double headingAngle(_N To ...) = {Atan2(-1, 0), _ '_N (up)
                                                Atan2(-1, 1), _ '_NE
                                                Atan2( 0, 1), _ '_E (right)
                                                Atan2( 1, 1), _ '_SE
                                                Atan2( 1, 0), _ '_S (down)
                                                Atan2( 1,-1), _ '_SW
                                                Atan2( 0,-1), _ '_W (left)
                                                Atan2(-1,-1) }  '_NW
Dim Shared As ZString*3 cardinalPoint(_N To ...) = {"N", "NE", "E", "SE", "S", "SW", "W", "NW"}
Dim Shared As ZString*4 cardinalDegree(_N To ...) = {"360", "045", "090", "135", "180", "225", "270", "315"}
Dim Shared As ZString*30 companyIdentifier(0 To ..., 1) = {{"DA", "Delta Airlines"}, _
                                                           {"LH", "Lufthansa"}, _
                                                           {"GW", "German Wings"}, _
                                                           {"AF", "Air France"}, _
                                                           {"AA", "American Airlines"}}
Dim Shared As String messageQueue, messageCallsign, message, firedReason
Dim Shared As tMMcolors scheduleColor, neutralColor, buttonColor, outScreenScheduleColor
Dim Shared As Double gameTime, refTime, sessionTime, sessionStartTime, totalDelay, messageTime
Dim Shared As Any Ptr bigFontWhite, bigFontRed, bigFontYellow, bigFontLtgreyT, midFontWhite

Declare Function zoomText(text As String, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
Declare Sub drawZoomText(x As Integer, y As Integer, text As String, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255))
Declare Function turnImg(img As Any Ptr, d As String = "r") As Any Ptr
Declare Function fix2grid(ByRef p As tPosition) As tPosition
Declare Function pol2cart(pk As tPolar) As tPosition
Declare Function cart2pol(pof As tPosition = Type(0,0), pto As tPosition = Type(0,0)) As tPolar
Declare Function angle2cardinal(angle As Double) As Integer
Declare Sub setup(ByRef lvl As tSetup)
Declare Sub saveini(lvl As tSetup)
Declare Function getini(varName As String) As String
Declare Function getVar(file As String, varName As String) As String
Declare Function putVar OverLoad (file As String, varName As String, value As String) As Integer
Declare Function putVar (file As String, varName As String, value As Integer) As Integer
Declare Function putVar (file As String, varName As String, value As Double) As Integer
Declare Function createBigFont(firstChr As Integer, lastChr As Integer, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
Declare Function createMidFont(firstChr As Integer, lastChr As Integer, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
Declare Function outScreen(p As tPosition) As boolean
Declare Sub waitRelease
Declare Function mouseMenu(text As String, _
                             separator As String = "", _
                             xPos As Integer = 0, _
                             yPos As Integer = 0, _
                             colors As tMMcolors, _
                             mode As UByte = 0, _
                             buffer As Any Ptr = 0) As Integer

'------------------------------

Type tRunway
    runwayType As Integer
    inColor As ULong
    outColor As ULong
    sign As String
    Union
        beginRunway As tPosition 'reference position of runway
        slotIn As tPosition 'reference position of slot
    End Union
    Union
        endRunway As tPosition 'if runway
        exitHeading As UByte 'if slot
    End Union
    timerem As Double
    Union
        bea As Integer 'if runway
        signImg As Any Ptr 'if slot
    End Union
    lockIn : 1 As UByte
    lockOut : 1 As UByte
    highlightIn : 1 As UByte
    highlightOut : 1 As UByte

    Declare Property direction() As Double
    Declare Property slotOut As tPosition

    Declare Sub drawRunway
    Declare Sub saveRunway(filenr As Integer)
    Declare Sub loadRunway(filenr As Integer)

End Type

Property tRunway.direction() As Double
    Dim As tPosition p
    Dim As Integer sc_width, sc_height

    ScreenInfo sc_width, sc_height
    Select Case runwayType
        Case _unidir, _bidir
            p = endRunway - beginRunway
            Return Atan2(p.y, p.x) 'runway direction angle
        Case _slot
            If slotIn.x < 10 Then 'left (western border)
                exitHeading = _W
            ElseIf slotIn.x > radar_sc - 10 Then 'right (eastern border)
                exitHeading = _E
            ElseIf slotIn.y < 10 Then 'top (northern border)
                exitHeading = _N
            ElseIf slotIn.y > radar_sc - 10 Then 'bottom (southern border)
                exitHeading = _S
            EndIf
            Return headingAngle(exitHeading)
    End Select

End Property

Property tRunway.slotOut As tPosition
    Dim As tPosition p

    p = slotIn
    Select Case direction
        Case headingAngle(_W) 'west
            p.y -= grid
        Case headingAngle(_E) 'east
            p.y += grid
        Case headingAngle(_N) 'north
            p.x += grid
        Case headingAngle(_S) 'south
            p.x -= grid
    End Select

    Return fix2grid(p)

End Property

Sub tRunway.drawRunway
    Dim As Integer dx, dy, w, h, f, sc_width, sc_height, sw, sh, tw, th, ch_width, ch_height, _
                   lockInOffsX, lockInOffsY, lockOutOffs
    Dim As Any Ptr tmpImg
    Dim As tPosition signpos

    Select Case runwayType
        Case _bidir
            w = 5
            Select Case direction
                Case headingAngle(_N), headingAngle(_S) 'north, south
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), black, bf
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), midgrey, b
                Case headingAngle(_E), headingAngle(_W) 'east, west
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), black, bf
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), midgrey, b
            End Select
            Line (beginRunway.x, beginRunway.y) - (endRunway.x, endRunway.y), midgrey, , &b0000000011111111

        Case _unidir
            w = 5
            Select Case direction
                Case headingAngle(_N), headingAngle(_S) 'north, south
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), black, bf
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), midgrey, b
                    Draw String (beginRunway.x + w + 3, beginRunway.y - 8), sign, midgrey
                Case headingAngle(_E), headingAngle(_W) 'east, west
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), black, bf
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), midgrey, b
                    Draw String (beginRunway.x, beginRunway.y + 10), sign, midgrey
            End Select
            Line (beginRunway.x, beginRunway.y) - (endRunway.x, endRunway.y), midgrey, , &b0000000011111111

            'beaconing
            If Timer > timerem Then
                timerem = Timer + .1
                bea = IIf(bea < 5, 60, bea - 5)
            EndIf
            For x As Integer = 5 To 40 Step 5
                Dim As Integer b, bc = IIf(x = bea, yellow, midgrey)
                Select Case direction
                    Case headingAngle(_N) 'north
                        b = beginRunway.y + x
                        PSet (beginRunway.x - 4, b), bc
                        PSet (beginRunway.x, b), bc
                        PSet (beginRunway.x + 4, b), bc
                    Case headingAngle(_E) 'east
                        b = beginRunway.x - x
                        PSet (b, beginRunway.y - 4), bc
                        PSet (b, beginRunway.y), bc
                        PSet (b, beginRunway.y + 4), bc
                    Case headingAngle(_S) 'south
                        b = beginRunway.y - x
                        PSet (beginRunway.x - 4, b), bc
                        PSet (beginRunway.x, b), bc
                        PSet (beginRunway.x + 4, b), bc
                    Case headingAngle(_W) 'west
                        b = beginRunway.x + x
                        PSet (b, beginRunway.y - 4), bc
                        PSet (b, beginRunway.y), bc
                        PSet (b, beginRunway.y + 4), bc
                End Select
            Next

        Case _slot
            direction 'asure exitHeading is set
            ScreenInfo sc_width, sc_height

            ImageInfo bigFontLtgreyT, ch_width, ch_height
            ch_height -= 1 'character image height
            ch_width = ch_height
            ch_height -= 2 'real character height

            sw = 60
            sh = grid + 7
            signImg = ImageCreate(sw, sh, tran)

            Draw String signImg, (3,0), "<<<<", outColor
            Draw String signImg, (3,grid), ">>>>", inColor

            'sign
            Select Case exitHeading
                Case _W
                    Draw String signImg, (0, sh / 2 - ch_height / 2), sign,, bigFontLtgreyT
                Case _E
                    tmpImg = turnImg(signImg, "r")
                    ImageDestroy signImg
                    signImg = tmpImg
                    tmpImg = turnImg(signImg, "r")
                    ImageDestroy signImg
                    signImg = tmpImg
                    Draw String signImg, (sw - Len(sign) * ch_width, sh / 2 - ch_height / 2), sign,, bigFontLtgreyT
                Case _N
                    tmpImg = turnImg(signImg, "r")
                    ImageDestroy signImg
                    signImg = tmpImg
                    For x As Integer = 0 To Len(sign) - 1
                        Draw String signImg, (sh / 2 - ch_width / 2 + 3, x * (ch_height + 2) + 1), Chr(sign[x]),, bigFontLtgreyT
                    Next
                Case _S
                    tmpImg = turnImg(signImg, "l")
                    ImageDestroy signImg
                    signImg = tmpImg
                    For x As Integer = 0 To Len(sign) - 1
                        Draw String signImg, (sh / 2 - ch_width / 2 + 3, (sh - Len(sign) * (ch_height + 2) + 3) + (x * (ch_height + 2) + 1)), Chr(sign[x]),, bigFontLtgreyT
                    Next
            End Select
            tmpImg = 0

            'write slot image to screen
            ImageInfo signImg, w, h
            Select Case exitHeading
                Case _W
                    Put (slotIn.x + 1, slotIn.y - grid - 3), signImg, Trans
                Case _E
                    Put (slotIn.x - w - 1, slotIn.y - 3), signImg, Trans
                Case _N
                    Put (slotIn.x - 3, slotIn.y + 1), signImg, Trans
                Case _S
                    Put (slotIn.x - grid - 6, slotIn.y - h), signImg, Trans
            End Select

            'set lock signs
            If lockIn Then
                signpos = slotIn
                Select Case exitHeading
                    Case _W
                        signpos.x += 15
                    Case _E
                        signpos.x -= 15
                    Case _N
                        signpos.y += 15
                    Case _S
                        signpos.y -= 15
                End Select
                Circle (signpos.x, signpos.y), 10, red,,,,F
                Circle (signpos.x, signpos.y), 7, white,,,,F
            EndIf

            If lockOut Then
                signpos = slotOut
                Select Case exitHeading
                    Case _W
                        signpos.x += 15
                    Case _E
                        signpos.x -= 15
                    Case _N
                        signpos.y += 15
                    Case _S
                        signpos.y -= 15
                End Select
                Circle (signpos.x, signpos.y), 10, red,,,,F
                Circle (signpos.x, signpos.y), 7, white,,,,F
            EndIf

            ImageDestroy signImg
            signImg = 0
    End Select

End Sub

Sub tRunway.saveRunway(filenr As Integer)

    Print #filenr, "RUNWAY/SLOT"
    Print #filenr, runwayType
    Print #filenr, sign

    direction 'to set exitHeading
    Select Case runwayType
        Case _unidir, _bidir
            Print #filenr, cardinalPoint(angle2cardinal(cart2pol(beginRunway, endRunway).phi)) 'heading
            Print #filenr, Int((beginRunway.x / grid) + .5)
            Print #filenr, Int((beginRunway.y / grid) + .5)
            Print #filenr, cart2pol(beginRunway, endRunway).r / (grid / NMperGrid) 'runway length in NM

        Case _slot
            Print #filenr, cardinalPoint(exitHeading)
            Select Case exitHeading
                Case _N, _S
                    Print #filenr, Int((slotIn.x / grid) + .5) 'grid points from left border
                Case _E, _W
                    Print #filenr, Int((slotIn.y / grid) + .5) 'grid points from top
            End Select
    End Select
End Sub

Sub tRunway.loadRunway(filenr As Integer)
    Dim As String card
    Dim As Double rwlen
    Dim As Integer hdg, sc_w, sc_h

    ScreenInfo sc_w, sc_h
    Input #filenr, runwayType
    Line Input #filenr, sign
    Line Input #filenr, card

    Select Case runwayType
        Case _unidir, _bidir
            For hdg = LBound(cardinalPoint) To UBound(cardinalPoint)
                If cardinalPoint(hdg) = card Then
                    Exit For
                EndIf
            Next
            Input #filenr, beginRunway.x
            Input #filenr, beginRunway.y
            Input #filenr, rwlen
            beginRunway = fix2grid(beginRunway * grid)
            endRunway = beginRunway + pol2cart(Type<tPolar>(rwlen * (grid / NMperGrid), headingAngle(hdg)))
        Case _slot
            Select Case card
                Case "N"
                    Input #filenr, slotIn.x
                    slotIn.x *= grid
                    slotIn.y = 0
                Case "E"
                    Input #filenr, slotIn.y
                    slotIn.y *= grid
                    slotIn.x = radar_sc
                Case "S"
                    Input #filenr, slotIn.x
                    slotIn.x *= grid
                    slotIn.y = radar_sc
                Case "W"
                    Input #filenr, slotIn.y
                    slotIn.y *= grid
                    slotIn.x = 0
            End Select
            fix2grid(slotIn)
    End Select
End Sub

ReDim Shared As tRunway runway(0)

'##########

Type tMark
    heading : 3 As UByte
    filled : 1 As UByte
    colors : 2 As UByte
    circ : 1 As UByte
End Type


Type tPlaneflag
    conflict : 1 As UByte
    crash : 1 As UByte
    turn : 1 As UByte
    tagStop : 1 As UByte
    underCursor : 1 As UByte
    getMessage : 2 As UByte
    'takeoff : 1 As UByte
    Union
        Type
            changeAltitude : 1 As UByte
            changeSpeed : 1 As UByte
            changeTurn : 1 As UByte
            takeoff : 1 As UByte
        End Type
        changeAny : 4 As UByte
    End Union
End Type


Type tPlane
    callsign As String
    origin As String
    destination As String
    position As tPosition
    target As tPosition

    xdisp As Integer
    ydisp As Integer
    tagDispx As Integer
    tagDispy As Integer
    tagDispBasex As Integer = 15 '10
    tagDispBasey As Integer = -29 '-24
    Union
        selbuffer_ As Byte
        selbuffer As tMark
    End Union

    altitude As Double 'ft
    targetAltitude As Integer 'ft
    messageAltitude As Integer 'ft
    climbrate As Integer = 30 'ft/min
    descendrate As Integer = 30 'ft/min
    tagAltitude As String

    direction As Double 'as angle
    turn As String
    messageTurn As String

    speed As Double 'kt
    targetSpeed As Integer 'kt
    messageSpeed As Integer 'kt
    maxSpeed As Integer = 450 'kt  (450kt = 833 km/h) '(500kt = 910 km/h)
    stallSpeed As Integer = 120 'kt (120kt = 222 km/h)
    approachSpeed As Integer = 150 'kt (150kt = 278 km/h)
    cruiseSpeed As Integer = 400 'kt (400kt = 740 km/h)
    acceleration As Integer = 5 'kt/s
    deceleration As Integer = 5 'kt/s
    tagSpeed As String

    timerem As Double
    scheduledDepartureTime As Double
    fuel As Double 'as time
    messageLock As Double '= 2
    Union
        planeflags As UShort 'for saving / loading
        planeflag As tPlaneflag
    End Union
    Union
        mark_ As Byte
        mark As tMark
    End Union
    flightstatus As Byte
    runway_ As Byte
    wheelrem As Integer
    listColor As tMMcolors
    comment As String

    Static As Integer tagTop
    Static As Integer tagBottom
    Static As Integer tagLeft
    Static As Integer tagRight
    Static As tPlane plane() 'planes array

    Declare Static Function create(org As Integer = 0) As boolean
    Declare Sub operate(mode As Integer)
    Declare Function checkApproach(runway As tRunway) As Integer
    Declare Sub savePlane(filenr As Integer)
    Declare Sub loadPlane(filenr As Integer)

End Type

'dim static variables
Static As Integer tPlane.tagTop    = -29 '-24
Static As Integer tPlane.tagBottom =  29 '24
Static As Integer tPlane.tagLeft   = -35 '-30
Static As Integer tPlane.tagRight  =  15 '10

ReDim As tPlane tPlane.plane(0)

Function tPlane.create(org As Integer = 0) As boolean
    Dim As Integer x, rwmax, pl, rw, dst, w, h, mx, my, wheel, buttons

    'org = -1 --> ignore lock of random origin

    rwmax = UBound(runway)

    'runway / slot where to place the new plane
    Select Case org
        Case 0
            Do
                For x = 1 To 10 'try max 10 times (to prevent game deadlock if all slots are locked)
                    rw = Int(Rnd * rwmax) + 1
                    If runway(rw).lockIn = 0 Then
                        Exit Do 'unlocked slot found
                    EndIf
                Next
                Return FALSE 'no free slot
            Loop
        Case -1
            rw = 1
        Case Else
            rw = org
            If runway(rw).lockIn Then
                Return FALSE 'desired slot is locked
            EndIf
    End Select

    If (runway(rw).runwayType = _slot) AndAlso (org <> -1) Then
        For pl = 1 To UBound(plane)
            If (plane(pl).target = runway(rw).slotIn) AndAlso (outScreen(plane(pl).position) = TRUE) Then
                Return FALSE 'another plane is currently approaching the entry point
            EndIf
        Next
    EndIf

    pl = UBound(plane) + 1 'index of new plane
    ReDim Preserve plane(pl)
    With plane(pl)
        .origin = runway(rw).sign
        GetMouse(mx,my,.wheelrem,buttons) 'get current mousewheel value
        Do 'create a callsign
            .callsign = companyIdentifier(Int(Rnd * UBound(companyIdentifier,1)), 0) + Str(Int(Rnd * 899) + 100)
            For x = 1 To UBound(plane) 'check if callsign is unique
                If x = pl Then 'skip own index
                    Continue For
                Else
                    If plane(x).callsign = .callsign Then 'callsign already exists
                        Continue Do 'create another callsign
                    EndIf
                EndIf
            Next
            Exit Do
        Loop

        .timerem = Timer
        Select Case runway(rw).runwayType
            Case _unidir, _bidir 'origin is a runway --> plane becomes scheduled
                .position = runway(rw).beginRunway
                .target = fix2grid(.position + pol2cart(Type<tPolar>(grid, runway(rw).direction)))
                .direction = cart2pol(.position, .target).phi 'ttttttttttttt
                .speed = 0
                .targetspeed = 0
                .targetaltitude = 0
                .altitude = 0
                .flightstatus = FS_SCHEDULED

            Case _slot 'origin is a slot --> plane is entering the radar screen
                runway(rw).direction
                'place the plane outside the screen, heading to the entry point
                .target = runway(rw).slotIn
                .position = .target + gridOffset(runway(rw).exitHeading)
                .direction = cart2pol(.position, .target).phi 'ttttttttttttt
                .speed = .cruiseSpeed
                .targetspeed = .cruiseSpeed
                .targetaltitude = 5000
                .altitude = 5000
                .flightstatus = FS_FLYING
        End Select

        .scheduledDepartureTime = DateAdd("n", 3, gameTime) 'add 3 minutes 'add 2 minutes

        Do 'get random flight destination
            dst = Int(Rnd * rwmax) + 1
        Loop While dst = rw 'repeat if destination = origin
        .destination = runway(dst).sign

    End With
    Return TRUE

End Function

Sub tPlane.operate(mode As Integer)
    Dim As Integer w, h, mx, my, wheel, buttons, x, index, chk, chk2, _
                   rw, chkApp, sc_width, sc_height, merken
    Dim As ULong turnColor
    Dim As String chk3, text
    Dim As Double timediff, angle, runwayDirection, distance, delay
    Dim As tPolar pol
    Dim As tPosition p
    Dim As tMMcolors tagColor, tagColorStd, tagColorConflict, tagColorMessage, tagColorMessageQueue

    tagColorStd.text = ltgreen
    tagColorStd.bgnd = black

    tagColorConflict = tagColorStd
    tagColorConflict.text = red

    tagColorMessage = tagColorStd
    tagColorMessage.text = yellow

    tagColorMessageQueue = tagColorStd
    tagColorMessageQueue.text = darkyellow

    listColor = tagColorStd
    listColor.text = darkgreen
    Swap listColor.foregroundhi, listColor.backgroundhi

    timediff = Timer - timerem
    timerem = Timer

    If flag.pause Or flag.setup Then 'game halted
        Return
    EndIf

    index =  (Cast(UInteger,@This) - Cast(UInteger,@tPlane.plane(0))) / SizeOf(tPlane) 'calculate the own index within the plane array
    '                         |                        |_pointer to the beginning of the plane array
    '                         |__________________________pointer to the actual plane

    ScreenInfo sc_width, sc_height

    '1 ft = 0,3048m
    '1 NM = 1852m = 6076 ft
    '1 kt = 6076 ft/h = 1,69 ft/s
    'scale = 6076 / grid 'ft/px
    'diff distance[ft] = speed[kt] * 1,69 ft/sec * timediff[s]
    'diff distance[px] = (speed[kt] * 1,69 ft/sec * timediff[s]) / scale[ft/px]



    pol = cart2pol(position, target) 'get the current direction angle
    pol.r = (speed * 1.69 * timediff) / scale 'distance covered since the last call
    position += pol2cart(pol) 'new position of the plane

    If Abs(position.y) < .0000001 Then 'prevent flickering when plane is at top of screen
        position.y = 0
    EndIf

    'ttttttttttttttt
    'If index = 4 Then
    '   Locate 40, 1
    '   ? direction;" ";angle2cardinal(direction);" ";position.x;" ";position.y;';outScreen(position)
    '   'Dim As Integer ff = FreeFile
    '   'Open "e:\ber.txt" For Append As #ff
    '   'Print #ff, position.x;" ";position.y;" ";mark.heading'cardinalDegree(mark.heading)
    '   'Close #ff
    'EndIf
    'ttttttttttttt
    Dim As Integer tst = Abs(angle2cardinal(direction) - angle2cardinal(pol.phi))
    If (tst = 1) Or (tst = 7) Then 'prevent turning to the opposite direction
        direction = pol.phi
    Else
        selbuffer.colors = 2
    EndIf

    'ttttttttttttttttt
    'If index = 1 Then
    '   Locate 41,1
    '   ? direction;" ";angle2cardinal(direction)
    'EndIf
    'ttttttttttttt

    mark.heading = angle2cardinal(direction)

    'chkApp * scale / NMft --> distance in NM
    'chkApp * scale        --> distance in ft

    chkApp = checkApproach(runway(runway_))

    '##### compute flightstatus #####
    If (flightstatus = FS_SCHEDULED) Then 'scheduled but not launched, not visible
        ImageInfo planeImg(mark.heading), w, h
        xdisp = position.x - w / 2
        ydisp = position.y - h / 2
        'calculate delay
        If scheduledDepartureTime < gameTime Then
            delay = gameTime - scheduledDepartureTime
            totalDelay += delay
        EndIf

        'if ready for takeoff
        If (planeflag.takeoff) And _
             (InStr(messagequeue, callsign) = 0) And _
             (messageCallsign <> callsign) Then
            messagequeue += callsign 'add plane to message queue
        EndIf

        Select Case planeflag.getMessage
            Case 0 'send takeoff order if plane is on the 1st place of the message queue and there's
                   ' no message being sent at the moment
                If (InStr(messageQueue, callsign) = 1) And (message = "") Then
                    messageQueue = Mid(messageQueue, Len(callsign) + 1) 'delete this plane from message queue

                    '##### generate takeoff message #####
                    messageCallsign = callsign

                    For c As Integer = LBound(companyIdentifier) To UBound(companyIdentifier)
                        If Left(callsign, 2) = companyIdentifier(c, 0) Then
                            message = companyIdentifier(c, 1) + " " + Mid(callsign, 3)
                            Exit For
                        EndIf
                    Next
                    messageTime = 1.5

                    If planeflag.takeoff Then
                        message += "   Cleared for takeoff"
                        messageTime += 1.5
                    EndIf

                    messageTime += Timer
                    '##### end generate takeoff message #####

                    planeflag.getMessage = 1
                EndIf
                Exit Sub
            Case 1 'set plane to be displayed
                If messageTime < Timer Then
                    flightstatus = FS_CLEAREDFORTAKEOFF
                EndIf
                Exit Sub
        End Select

    'takeoff procedure
    ElseIf (flightstatus = FS_CLEAREDFORTAKEOFF) Then 'cleared for takeoff
        targetspeed = 250
        planeflag.takeoff = 1
        flightstatus = FS_ACCELERATINGFORTAKEOFF 'accelerating, still on the ground
    ElseIf (flightstatus = FS_ACCELERATINGFORTAKEOFF) And (speed >= approachspeed) Then 'takeoff
        targetaltitude = 1000
        flightstatus = FS_FLYING 'flying

    'landing procedure
    ElseIf (flightstatus = FS_LANDING_TOUCHDOWN) AndAlso (altitude = 0) AndAlso (speed < 15) Then
        If runway(runway_).sign = destination Then
            flightstatus = FS_REMOVE 'phase 6 --> remove
        Else 'wrong landing --> replace to schedule
            position = runway(runway_).beginRunway
            target = fix2grid(position + pol2cart(Type<tPolar>(grid, runway(runway_).direction)))
            flightstatus = FS_RESCHEDULE
        EndIf
    ElseIf (flightstatus = FS_LANDING_THRESHOLD) AndAlso (altitude = 0) Then
        targetspeed = 0
        flightstatus = FS_LANDING_TOUCHDOWN 'phase 5 --> touchdown
    ElseIf (flightstatus = FS_LANDING_CLOSER1_5NM) AndAlso _
             (chkApp = FSA_ABOVERUNWAY) AndAlso _
             (speed <= approachspeed) AndAlso _
             (altitude <= 100) Then
        targetaltitude = 0
        flightstatus = FS_LANDING_THRESHOLD 'phase 4 --> crossing runway threshold
    ElseIf (flightstatus = FS_LANDING_CLOSER5NM) AndAlso (chkApp > 0) AndAlso ((chkApp * scale / NMft) < 1.5) Then
        targetspeed = IIf(targetspeed > approachspeed, approachspeed, targetspeed)
        flightstatus = FS_LANDING_CLOSER1_5NM 'phase 3 --> closer than 1.5 NM
    ElseIf (flightstatus = FS_LANDING_HEADINGTORUNWAY) AndAlso (chkApp > 0) AndAlso ((chkApp * scale / NMft) < 5) Then
        targetspeed = IIf(targetspeed > 250, 250, targetspeed)
        flightstatus = FS_LANDING_CLOSER5NM 'phase 2 --> closer than 5 NM
    ElseIf flightstatus = FS_CLEAREDFORLANDING Then 'cleared for landing --> get the runway heading to
        For rw = 1 To UBound(runway)
            chkApp = checkApproach(runway(rw))
            If (chkApp > 0) AndAlso (turn = "") Then 'heading to runway
                flightstatus = FS_LANDING_HEADINGTORUNWAY 'phase 1 --> heading to the runway
                runway_ = rw 'store runway
                Exit For
            EndIf
        Next
    ElseIf flightstatus = FS_FLYING Then
        runway_ = 0
    EndIf

    Select Case flightstatus
        Case FS_LANDING_CLOSER5NM, FS_LANDING_CLOSER1_5NM 'glide slope
            If (chkApp > 0) And (targetaltitude > (chkApp * scale / 20)) Then
                targetaltitude = (chkApp * scale / 20)
                targetaltitude = IIf(targetaltitude < 100, 100, targetaltitude)
            EndIf
    End Select
    '##### end compute flightstatus #####

    'calculate altitude
    If Abs(altitude - targetaltitude) < 1 Then
        altitude = targetaltitude
    ElseIf (altitude < targetaltitude) And (speed >= approachspeed) Then
        altitude += timediff * climbrate
    ElseIf altitude > targetaltitude Then
        altitude -= timediff * IIf(flightstatus < FS_LANDING_THRESHOLD, descendrate, 5)
    EndIf

    'calculate speed
    If Abs(speed - targetspeed) < 1 Then
        speed = targetspeed
    ElseIf speed < targetspeed Then
        speed += timediff * acceleration
    ElseIf speed > targetspeed Then
        speed -= timediff * deceleration
    EndIf

    'check for conflict
    planeflag.conflict = 0
    For x = 1 To UBound(plane) 'all planes
        If (x = index) OrElse (plane(x).flightstatus = FS_SCHEDULED) Then
            Continue For 'skip if own index or plane not airborne
        EndIf
        distance = cart2pol(plane(x).position, plane(index).position).r
        If distance < 2 * (grid  / NMperGrid) And _ 'less than 2 NM
             Abs(plane(x).altitude - plane(index).altitude) < 1000 Then
            planeflag.conflict = 1
            If distance < (150 / scale) AndAlso Abs(plane(x).altitude - plane(index).altitude) < 50 Then
                planeflag.crash = 1 'crash
                plane(x).planeflag.crash = 1
            EndIf
        EndIf
    Next
    chk3 = Str(flightstatus) + " " + Str(chkApp)
    If (flightstatus > FS_LANDING_CLOSER1_5NM) And (chkApp = FSA_NOAPPROACH) Then
        planeflag.conflict = 1
        If (flightstatus > FS_LANDING_THRESHOLD) Then
            planeflag.crash = 1 'crash
        EndIf
    EndIf

    'arriving target position
    'If cart2pol(target, position).r < .5 Then
    If cart2pol(target, position).r <= .5 Then
        position = target 'correct misalignment
        Select Case Left(turn, 1)
            Case "r" 'turn right
                mark.heading += 1
                turn = Mid(turn, 2) 'delete the first character from the turn string
            Case "l" 'turn left
                mark.heading -= 1
                turn = Mid(turn, 2)
        End Select

        target += gridOffset(mark.heading) 'set next grid point in heading direction as new target
        fix2grid(target) 'correct misalignment
    EndIf

    '##### check exit #####
    If outScreen(target) Then
        flightstatus = FS_BADEXIT 'preset
        comment = "NOT AN EXIT POINT"
        For x = 1 To UBound(runway) 'find index of destination slot
            With runway(x)
                If (.runwayType = _slot) AndAlso (cart2pol(position, .slotOut).r < 0.1) Then
                    comment = ""
                    Exit For
                EndIf
            End With
        Next
        If comment = "" Then 'regular exit point
            With runway(x)
                If (mark.heading <> .exitHeading) Then
                    comment = "WRONG HEADING (" + cardinalPoint(mark.heading) + ")"
                ElseIf (destination <> .sign) Then
                    comment = "WRONG DESTINATION (" + destination + ")"
                ElseIf (speed > 400) Then
                    comment = "SPEED TOO HIGH (" + Str(Int(speed)) + "kt)"
                ElseIf (altitude <> 5000) Then
                    comment = "WRONG ALTITUDE (" + Str(Int(altitude)) + "ft)"
                EndIf
            End With
        EndIf

        If comment = "" Then 'regular exit
            flightstatus = FS_EXIT
        EndIf
    EndIf
    '##### end check exit #####

    '##### update radar display position #####
    ImageInfo planeImg(mark.heading), w, h 'get plane icon size

    If mode And (planeflag.turn = 0) Then 'update radar display
        xdisp = position.x - w / 2
        ydisp = position.y - h / 2
        'keep tag inside the radar display area
        If xdisp < 40 Then 'left border
            tagDispBasex = tagRight
            If mark.heading = _W Then
                tagDispBasey = tagTop
            Else
                tagDispBasey = tagBottom
            EndIf
        ElseIf xdisp > radar_sc - 70 Then 'right border
            tagDispBasex = tagLeft
            If mark.heading = _E Then
                tagDispBasey = tagBottom
            Else
                tagDispBasey = tagTop
            EndIf
        EndIf
        If ydisp < 30 Then 'top border
            If mark.heading = _N Then
                tagDispBasex = tagRight
            Else
                tagDispBasex = tagLeft
            EndIf
            tagDispBasey = tagBottom
        ElseIf ydisp > radar_sc - 51 Then 'bottom border
            If mark.heading = _S Then
                tagDispBasex = tagLeft
            Else
                tagDispBasex = tagRight
            EndIf
            tagDispBasey = tagTop
        EndIf
    EndIf
    '##### end update radar display position #####

    If Not outScreen(position) Then 'display plane and tag
        listColor = tagColorStd
        Swap listColor.foregroundhi, listColor.backgroundhi

        selbuffer_ = mark.heading 'get the correct plane icon

        'test if cursor is touching the plane icon
        GetMouse (mx,my,wheel,buttons)
        If (Abs(position.x - mx) < 10) AndAlso _
             (Abs(position.y - my) < 10) Then 'mouse cursor is touching the plane icon
            selbuffer.filled = 1
            planeflag.underCursor = 1
        Else
            planeflag.underCursor = 0
        EndIf

        'get plane icon color
        If planeflag.conflict Then
            selbuffer.colors = 1 'red
            If Frac(Timer) > .5 Then 'flashing icon
                selbuffer.filled = 1
            EndIf
        Else
            selbuffer.colors = mark.colors 'selected color
            'ttttttttttttt
            'If index = 1 Then
            '   selbuffer.colors = 2
            'EndIf
            'ttttttttttttt
        EndIf

        If messageLock > Timer Then
            selbuffer.filled = 1
        EndIf

        If planeflag.turn Then 'get the correct turning preview plane icon
            If Left(messageTurn, 1) = "l" Then
                selbuffer.heading = mark.heading - Len(messageTurn)
            ElseIf Left(messageTurn, 1) = "r" Then
                selbuffer.heading = mark.heading + Len(messageTurn)
            EndIf
        EndIf

        Put (xdisp, ydisp), planeImg(selbuffer_), Trans 'draw plane icon

        ''--------- for testing-----------
        'If Len(turn) Then
        '   mark.circ = 1
        'Else
        '   mark.circ = 0
        'EndIf
        ''---------------------------------

        If mark.circ Then
            For x As Integer = 10 To 14 Step 2
                Circle (xdisp + 10, ydisp + 10), x, green 'red
                'Circle (xdisp + 10, ydisp + 10), Int(Frac(Timer)*10) + 5, green 'red
            Next
        EndIf

        'draw tag
        listColor.foreground = ltgreen

        If planeflag.tagStop = 0 Then 'set tag position relative to plane position
            tagDispx = tagDispBasex + xdisp
            tagDispx = IIf(tagDispx < 1, 1, tagDispx)
            tagDispy = tagDispBasey + ydisp
            tagDispy = IIf(tagDispy < 1, 1, tagDispy)
            If planeflag.changeAltitude = 0 Then messageAltitude = targetAltitude
            If planeflag.changeSpeed = 0 Then messageSpeed = targetSpeed
            If planeflag.changeTurn = 0 Then messageTurn = turn
        Else
            listColor.foreground = white 'highlight list entry
        EndIf

        If planeflag.underCursor Then 'cursor is touching the plane icon
            listColor.foreground = white 'highlight list entry
        EndIf

        'set tag color
        tagColor = tagColorStd 'no conflict
        If ((lvl.helpmessage = 1) And (planeflag.underCursor)) OrElse (lvl.helpmessage = 2) Then
            If messageCallsign = callsign Then
                tagColor = tagColorMessage
            ElseIf InStr(messageQueue, callsign) Then
                tagColor = tagColorMessageQueue
            EndIf
        EndIf

        If planeflag.conflict And (Frac(Timer) > .5) Then 'flashing tag / list
            listcolor.foreground = red
            tagColor = tagColorConflict
        EndIf

        planeflag.tagStop = 0


        'callsign / marking
        Select Case mouseMenu(IIf(((lvl.helpdest = 1) And (planeflag.underCursor)) Or (lvl.helpdest = 2), _
                                    destination, callsign),, tagDispx, tagDispy, tagColor)
            Case 8
                planeflag.tagStop = 1 'cursor touching tag --> avoid tag moving
            Case 9
                mark.colors += 1 'switch colors
                planeflag.tagStop = 1
            Case 10
                mark.colors = 0 'reset to ltgreen
                planeflag.tagStop = 1
        End Select

        'altitude
        Select Case mouseMenu(tagAltitude,, 0, -8, tagColor)
            Case 0 'display actual altitude
                tagAltitude = Str(Int(altitude)) + " ft"
            Case 8 'mousecursor touches item --> display target altitude
                If flightstatus Then
                    tagAltitude = "LANDING "
                Else
                    tagAltitude = Str(messageAltitude) + " ft"
                EndIf
                planeflag.tagStop = 1
            Case 9 'left button --> increase target altitude
                If messageAltitude < 6000 Then
                    messageAltitude += 1000
                    planeflag.changeAltitude = 1
                EndIf
                flightstatus = FS_FLYING
                planeflag.tagStop = 1
            Case 10 'right button --> decrease target altitude
                If messageAltitude > 1000 Then
                    messageAltitude -= 1000
                    planeflag.changeAltitude = 1
                Else
                    flightstatus = FS_CLEAREDFORLANDING
                    planeflag.changeAltitude = 1
                EndIf
                planeflag.tagStop = 1
        End Select

        'speed
        Select Case mouseMenu(tagSpeed + " kt",, 0, -8, tagColor)
            Case 0
                tagSpeed = Str(Int(speed))
            Case 8
                tagSpeed = Str(messageSpeed)
                planeflag.tagStop = 1
            Case 9 'accelerate
                If (messageSpeed = 0) And (planeflag.takeoff = 1) Then
                    messageSpeed = 300
                ElseIf messageSpeed < maxspeed Then
                    messageSpeed += 50
                    planeflag.changeSpeed = 1
                    If messageSpeed > maxspeed Then
                        messageSpeed = maxspeed
                    EndIf

                EndIf
                planeflag.tagStop = 1
            Case 10 'slow down
                If messageSpeed > stallSpeed Then
                    messageSpeed -= 50
                    planeflag.changeSpeed = 1
                    If messageSpeed < stallSpeed Then
                        messageSpeed = stallSpeed
                    EndIf
                EndIf
                planeflag.tagStop = 1
        End Select

        '################################
        #Macro turnIndicator
            If Left(turn, 1) = "r" Then
                Circle (xdisp + 10, ydisp + 10), 15, green, _
                        _2pi - headingAngle((mark.heading + Len(turn)) And &b111), _
                        (_2pi - headingAngle(mark.heading))
            ElseIf Left(turn, 1) = "l" Then
                Circle (xdisp + 10, ydisp + 10), 15, green, _
                        (_2pi - headingAngle(mark.heading)), _
                        _2pi - headingAngle((mark.heading - Len(turn)) And &b111)
            EndIf
        #EndMacro
        '################################

        If (Bit(lvl.helpturn, 1)) Then
            turnIndicator 'macro
        EndIf

        GetMouse (mx,my,wheel,buttons)

        'turning (mouse cursor touches the plane icon)
        If planeflag.underCursor = 1 Then 'mouse cursor touches the plane icon

            '-------------------------------
            Locate 5,1
            ? "      index ";index
            ? "       turn ";turn
            ? "messageturn ";messageturn
            ? planeflag.turn
            ? cardinalDegree(mark.heading)
            '-------------------------------

            If (Bit(lvl.helpturn, 0)) AndAlso (Len(turn) <> 0) AndAlso (planeflag.turn = 0) Then
                turnIndicator 'macro
            EndIf

            If buttons Then
                If (planeflag.turn = 0) And (Bit(buttons, 2) = 0) Then 'no mid button
                    messageTurn = "" 'cancel previous turning order
                EndIf
                planeflag.turn = 1

                If (buttons = 1) And (InStr(messageTurn, "r") = 0) And (Len(messageTurn) <= 7) Then 'left button --> turn left
                    messageTurn += "l"
                    planeflag.changeTurn = 1
                    waitRelease
                ElseIf buttons = 2 And (InStr(messageTurn, "l") = 0) And (Len(messageTurn) <= 7) Then 'right button --> turn right
                    messageTurn += "r"
                    planeflag.changeTurn = 1
                    waitRelease
                ElseIf buttons = 4 Then 'mid mutton --> cancel turning
                    messageTurn = "c"
                    planeflag.changeTurn = 1
                    waitRelease
                EndIf
            EndIf


            '##### move tag #####
            GetMouse (mx,my,wheel,buttons)
            If wheel > wheelrem Then 'move tag
                If (tagDispBasex = tagRight) And (tagDispBasey = tagTop) Then 'top right
                    tagDispBasex = tagLeft
                ElseIf (tagDispBasex = tagLeft) And (tagDispBasey = tagTop) Then 'top left
                    tagDispBasey = tagBottom
                ElseIf (tagDispBasex = tagLeft) And (tagDispBasey = tagBottom) Then 'bottom left
                    tagDispBasex = tagRight
                Else 'set to top right
                    tagDispBasex = tagRight
                    tagDispBasey = tagTop
                EndIf
            ElseIf wheel < wheelrem Then
                If (tagDispBasex = tagRight) And (tagDispBasey = tagTop) Then 'top right
                    tagDispBasey = tagBottom
                ElseIf (tagDispBasex = tagRight) And (tagDispBasey = tagBottom) Then 'bottom right
                    tagDispBasex = tagLeft
                ElseIf (tagDispBasex = tagLeft) And (tagDispBasey = tagBottom) Then 'bottom left
                    tagDispBasey = tagTop
                Else 'set to top right
                    tagDispBasex = tagRight
                    tagDispBasey = tagTop
                EndIf
            EndIf
            '##### end move tag #####
        Else 'mouse cursor doesn't touch the plane icon
            planeflag.turn = 0
        EndIf
    EndIf   'display plane and tag
    wheelrem = wheel

    If planeflag.tagStop Or planeflag.underCursor Then
        messageLock = Timer + .6
    EndIf

    'submit message
    If (messageLock < Timer)               AndAlso _
         (planeflag.changeAny <> 0)          AndAlso _
         (InStr(messageQueue, callsign) = 0) AndAlso _
         (messageCallsign <> callsign)       Then 'add callsign to message queue
        messageQueue += callsign
    EndIf

    'proceed message
    Select Case planeflag.getMessage
        Case 0 'send message if plane is on the 1st place of the message queue and there's
               ' no message being sent at the moment
            If (InStr(messageQueue, callsign) = 1) And (message = "") Then
                messageQueue = Mid(messageQueue, Len(callsign) + 1) 'delete this plane from message queue

                '##### generate message #####
                messageCallsign = callsign

                For c As Integer = LBound(companyIdentifier) To UBound(companyIdentifier)
                    If Left(callsign, 2) = companyIdentifier(c, 0) Then
                        message = companyIdentifier(c, 1) + " " + Mid(callsign, 3)
                        Exit For
                    EndIf
                Next
                messageTime = 1.5

                If (planeflag.changeTurn) Then
                    If Left(messageTurn, 1) = "r" Then
                        message += "   Turn right to " + cardinalDegree((mark.heading + Len(messageTurn)) Mod 8)
                        messageTime += 1.5
                    ElseIf Left(messageTurn, 1) = "l" Then
                        message += "   Turn left to " + cardinalDegree((mark.heading - Len(messageTurn)) Mod 8)
                        messageTime += 1.5
                    ElseIf messageTurn = "c" Then
                        message += "   Keep heading"
                        messageTime += 1.5
                    EndIf
                'ElseIf Left(turn, 1) = "r" Then
                '   message += "   Turn right to " + cardinalDegree((mark.heading + Len(turn)) Mod 8)
                '   messageTime += 1.5
                'ElseIf Left(turn, 1) = "l" Then
                '   message += "   Turn left to " + cardinalDegree((mark.heading - Len(turn)) Mod 8)
                '   messageTime += 1.5
                EndIf

                'If (planeflag.changeAltitude = 0) And (altitude <> targetaltitude) Then
                '   messagealtitude = targetaltitude
                '   planeflag.changeAltitude = 1
                'EndIf

                If (planeflag.changeAltitude) And (flightstatus <> FS_CLEAREDFORLANDING)Then
                    'If flightstatus <> FS_CLEAREDFORLANDING Then
                        If messageAltitude > altitude Then
                            message += "   Climb to " + Str(messageAltitude) + " feet"
                            messageTime += 1.5
                        ElseIf messageAltitude < altitude Then
                            message += "   Descend to " + Str(messageAltitude) + " feet"
                            messageTime += 1.5
                        Else
                            planeflag.changeAltitude = 0
                        EndIf
                    'EndIf
                EndIf

                If (planeflag.changeSpeed) Then
                    If messageSpeed > speed Then
                        message += "   Accelerate to " + Str(messageSpeed) + " knots"
                        messageTime += 1.5
                    ElseIf messageSpeed < speed Then
                        message += "   Slow down to " + Str(messageSpeed) + " knots"
                        messageTime += 1.5
                    Else
                        planeflag.changeSpeed = 0
                    EndIf
                EndIf

                If flightstatus = FS_CLEAREDFORLANDING Then
                    message += "   Cleared for landing"
                    messageTime += 1.5
                EndIf

                messageTime += Timer

                '##### end generate message #####

                planeflag.getMessage = 1
            EndIf
        Case 1 'wait for order to be transmitted, then execute
            If messageTime < Timer Then
                If planeflag.changeAltitude Then
                    If flightstatus = FS_CLEAREDFORLANDING Then
                        targetAltitude = 1000
                    Else
                        targetAltitude = messageAltitude
                    EndIf
                EndIf

                If (planeflag.takeoff = 1) And (planeflag.changeSpeed = 0) Then
                    messagespeed = 250
                    planeflag.changeSpeed = 1
                EndIf

                If (planeflag.changeSpeed) Then
                    targetSpeed = messageSpeed
                EndIf

                If planeflag.changeTurn Then
                    If messageTurn = "c" Then
                        turn = ""
                    Else
                        turn = messageTurn
                    EndIf
                EndIf

                planeflag.changeAny = 0
                planeflag.getMessage = 2
                message = "                                    Roger"
                messageTime = Timer + 1.8
                mark.circ = 1
            EndIf
        Case 2 'confirm
            If messageTime < Timer Then
                planeflag.getMessage = 0
                mark.circ = 0
                message = ""
                messageCallsign = ""
            EndIf
    End Select

End Sub

Function tPlane.checkApproach(runway As tRunway) As Integer
    Dim As tPosition p2
    Dim As Double oppdirection

    With runway
        Select Case .runwayType
            Case _bidir
                p2 = .beginRunway - .endRunway
                oppdirection = Atan2(p2.y, p2.x)
                If (Abs(.direction - direction) < .001) AndAlso _
                   (Abs(cart2pol(position, .beginRunway).phi - direction) < .001) Then
                    Return cart2pol(position, runway.beginRunway).r 'distance to runway threshold
                ElseIf (Abs(oppdirection - direction) < .001) AndAlso _
                       (Abs(cart2pol(position, .endRunway).phi - direction) < .001) Then
                    Return cart2pol(position, runway.endRunway).r 'distance to runway threshold
                Else
                    If (Abs(cart2pol(.beginRunway, position).phi - .direction) < .001) And _
                         (Abs(cart2pol(position, .endRunway).phi - .direction) < .001) Then
                        Return FSA_ABOVERUNWAY '-2 'plane above the runway
                    Else
                        Return FSA_NOAPPROACH '-1 'no approach
                    EndIf
                EndIf
            Case _unidir
                If (Abs(.direction - direction) < .001) AndAlso _
                   (Abs(cart2pol(position, .beginRunway).phi - direction) < .001) Then
                    Return cart2pol(position, runway.beginRunway).r 'distance to runway threshold
                Else
                    If (Abs(cart2pol(.beginRunway, position).phi - .direction) < .001) And _
                         (Abs(cart2pol(position, .endRunway).phi - .direction) < .001) And _
                         (Abs(direction - .direction) < .001) Then
                        Return FSA_ABOVERUNWAY '-2 'plane correct above the runway
                    Else
                        Return FSA_NOAPPROACH '-1 'no approach
                    EndIf
                EndIf
        End Select
    End With

End Function

Sub tPlane.savePlane(filenr As Integer)

    Print #filenr, "PLANE"
    Print #filenr, callsign
    Print #filenr, destination
    Print #filenr, origin
    Print #filenr, position.x
    Print #filenr, position.y
    Print #filenr, tagDispBasex
    Print #filenr, tagDispBasey
    Print #filenr, target.x
    Print #filenr, target.y
    Print #filenr, selbuffer_
    Print #filenr, altitude
    Print #filenr, targetAltitude
    Print #filenr, messageAltitude
    Print #filenr, direction
    Print #filenr, turn
    Print #filenr, messageTurn
    Print #filenr, speed
    Print #filenr, targetSpeed
    Print #filenr, messageSpeed
    Print #filenr, timerem
    Print #filenr, scheduledDepartureTime
    Print #filenr, fuel
    Print #filenr, planeflags
    Print #filenr, mark_
    Print #filenr, flightstatus
    Print #filenr, runway_

End Sub

Sub tPlane.loadPlane(filenr As Integer)

    Input #filenr, callsign
    Input #filenr, destination
    Input #filenr, origin
    Input #filenr, position.x
    Input #filenr, position.y
    Input #filenr, tagDispBasex
    Input #filenr, tagDispBasey
    Input #filenr, target.x
    Input #filenr, target.y
    Input #filenr, selbuffer_
    Input #filenr, altitude
    Input #filenr, targetAltitude
    Input #filenr, messageAltitude
    Input #filenr, direction
    Input #filenr, turn
    Input #filenr, messageTurn
    Input #filenr, speed
    Input #filenr, targetSpeed
    Input #filenr, messageSpeed
    Input #filenr, timerem
    Input #filenr, scheduledDepartureTime
    Input #filenr, fuel
    Input #filenr, planeflags
    Input #filenr, mark_
    Input #filenr, flightstatus
    Input #filenr, runway_
    timerem = Timer
    operate(0)
End Sub


'####################################################################
'####################################################################
'####################################################################
'####################################################################
'####################################################################


Dim As Integer sc_width, sc_height, messageLine, x, y, z, p, w, h, ff, w2, h2, bpp, _
               update, flightsDone, planes, remColumns, remLines
Dim As Integer mx, my, buttons, wheel
Dim As String g, key
Dim As Double conflictTime, timenew, timepause, timeupd, timeremPause, timerem = Timer
Dim As Any Ptr fontColor
Dim As tPosition scalePos

Randomize

ScreenRes 600, 400, 32
'ScreenSet 1,0

'create plane icon images
w = 20 'icon width
h = 20 'icon height

'&b01111111
'   ||/||||__+45° clockwise (north = 0°)
'   || |||___+90°
'   || ||____+180°
'   || |_____0 = outline  1 = filled
'   ||_______color 00 = ltgreen  01 = red  10 = cyan  11 = yellow
'   |________1 = circle around the plane icon

'outline straight
planeImg(IMG_LTGREEN) = ImageCreate(w, h, tran)
planeImg(IMG_RED) = ImageCreate(w, h, tran)
planeImg(IMG_CYAN) = ImageCreate(w, h, tran)
planeImg(IMG_YELLOW) = ImageCreate(w, h, tran)
Restore outlineStraight
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet planeImg(IMG_LTGREEN), (x, y), ltgreen
            PSet planeImg(IMG_RED),     (x, y), red
            PSet planeImg(IMG_CYAN),    (x, y), cyan
            PSet planeImg(IMG_YELLOW),  (x, y), yellow
        EndIf
    Next
Next

'outline diagonal
planeImg(IMG_LTGREEN Or _NE) = ImageCreate(w, h, tran)
planeImg(IMG_RED Or _NE) = ImageCreate(w, h, tran)
planeImg(IMG_CYAN Or _NE) = ImageCreate(w, h, tran)
planeImg(IMG_YELLOW Or _NE) = ImageCreate(w, h, tran)
Restore outlineDiagonal
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet planeImg(IMG_LTGREEN Or _NE), (x, y), ltgreen
            PSet planeImg(IMG_RED Or _NE),     (x, y), red
            PSet planeImg(IMG_CYAN Or _NE),    (x, y), cyan
            PSet planeImg(IMG_YELLOW Or _NE),  (x, y), yellow
        EndIf
    Next
Next

'filled straight
planeImg(IMG_LTGREEN Or IMG_FILLED) = ImageCreate(w, h, tran)
planeImg(IMG_RED Or IMG_FILLED) = ImageCreate(w, h, tran)
planeImg(IMG_CYAN Or IMG_FILLED) = ImageCreate(w, h, tran)
planeImg(IMG_YELLOW Or IMG_FILLED) = ImageCreate(w, h, tran)
Restore filledStraight
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet planeImg(IMG_LTGREEN Or IMG_FILLED), (x, y), ltgreen
            PSet planeImg(IMG_RED Or IMG_FILLED),     (x, y), red
            PSet planeImg(IMG_CYAN Or IMG_FILLED),    (x, y), cyan
            PSet planeImg(IMG_YELLOW Or IMG_FILLED),  (x, y), yellow
        EndIf
    Next
Next

'filled diagonal
planeImg(IMG_LTGREEN Or IMG_FILLED Or _NE) = ImageCreate(w, h, tran)
planeImg(IMG_RED Or IMG_FILLED Or _NE) = ImageCreate(w, h, tran)
planeImg(IMG_CYAN Or IMG_FILLED Or _NE) = ImageCreate(w, h, tran)
planeImg(IMG_YELLOW Or IMG_FILLED Or _NE) = ImageCreate(w, h, tran)
Restore filledDiagonal
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet planeImg(IMG_LTGREEN Or IMG_FILLED Or _NE), (x, y), ltgreen
            PSet planeImg(IMG_RED Or IMG_FILLED Or _NE),     (x, y), red
            PSet planeImg(IMG_CYAN Or IMG_FILLED Or _NE),    (x, y), cyan
            PSet planeImg(IMG_YELLOW Or IMG_FILLED Or _NE),  (x, y), yellow
        EndIf
    Next
Next

'create images of the other 7 directions
For d As Integer = _E To _NW 'all directions
    For c As Integer = IMG_LTGREEN To IMG_YELLOW Step IMG_RED 'all colors
        planeImg(d + c) = turnImg(planeImg(d - 2 + c)) 'outline
        planeImg(d + c + IMG_FILLED) = turnImg(planeImg(d - 2 + c + IMG_FILLED)) 'filled
    Next
Next

'set mouse menu colors
With neutralColor
    .text = white
    .bgnd = black
    Swap .foregroundhi, .backgroundhi 'no change of colors when touching the item
End With

With scheduleColor
    .text = yellow
    .bgnd = black
End With

With outScreenScheduleColor
    .text = darkyellow
    .bgnd = black
    Swap .foregroundhi, .backgroundhi 'no change of colors when touching the item
End With

With buttonColor
    .text = white
    .bgnd = black
End With

'create big fonts
bigFontWhite   = createBigFont(32, 127, white, black)
bigFontRed     = createBigFont(32, 127, red, black)
bigFontYellow  = createBigFont(32, 127, yellow, black)
bigFontLtgreyT = createBigFont(32, 127, ltgrey, tran)
midFontWhite   = createMidFont(32, 127, white, black)

Randomize
Do '##### GAME LOOP #####

    '##### LEVEL SETUP #####

    ChDir ExePath

    'load setup data
    lvl.lvlName = getini("actLevel") 'get actual level file
    lvl.maxPlanes = Val(getini("maxPlanes"))
    lvl.newPlaneGap = Val(getini("newPlaneGap"))
    lvl.helpturn = Val(getini("helpturn"))
    lvl.helpdest = Val(getini("helpdest"))
    lvl.helpmessage = Val(getini("helpmessage"))

    If lvl.lvlName = "" Or _
         Not(FileExists(lvl.lvlName)) Or _
         lvl.maxPlanes = 0 Or _
         lvl.newPlaneGap = 0 Then
        ScreenRes 1000, 900, 32, 2 'screen for setup
        ScreenSet 1,0
        setup(lvl)
        Continue Do 'restart level
    EndIf

    grid = Val(getVar(lvl.lvlName, "grid")) 'pixels
    NMperGrid = Val(getVar(lvl.lvlName, "NMperGrid")) 'NM per grid point
    scale = NMperGrid * NMft / grid 'ft/pixel
    messageLine = 32
    radar_sc = Int(900 / grid) * grid

    ScreenRes radar_sc + 140, radar_sc + messageLine + 1, 32, 2 'game screen
    ScreenSet 1,0
    ScreenInfo sc_width, sc_height

    'Open Cons For Output As #100
    'Print #100, sc_width, sc_height
    'Print #100, grid
    'Print #100, lvl.lvlName
    'Close 100

    'calculate grid offsets
    gridOffset(_N)  = Type<tPosition>(0,-grid)
    gridOffset(_NE) = Type<tPosition>(grid,-grid)
    gridOffset(_E)  = Type<tPosition>(grid,0)
    gridOffset(_SE) = Type<tPosition>(grid,grid)
    gridOffset(_S)  = Type<tPosition>(0,grid)
    gridOffset(_SW) = Type<tPosition>(-grid,grid)
    gridOffset(_W)  = Type<tPosition>(-grid,0)
    gridOffset(_NW) = Type<tPosition>(-grid,-grid)

    'set runway(s) and slot(s)
    ReDim runway(0)
    ff = FreeFile
    Open lvl.lvlName For Input As #ff
    Do Until Eof(ff)
        Input #ff, g
        If g = "RUNWAY/SLOT" Then
            x = UBound(runway) + 1
            ReDim Preserve runway(x)
            runway(x).loadRunway(ff)
        EndIf
    Loop
    Close ff

    'For x = 1 To UBound(runway)
    '   runway(x).inColor = green
    '   runway(x).outColor = white
    'Next

    If FileExists("resume.pln") Then
        remLines = HiWord(Width)
        remColumns = LoWord(Width)
        Width sc_width / 8, sc_height / 16
        Draw String (sc_width / 2 - 185, 50), "Welcome to BER Approach!",,bigFontWhite
        Do
            If mouseMenu(" Resume last game ",, sc_width / 2 - 65, 150, buttonColor, 2) = 9 Then
                ff = FreeFile
                Open "resume.pln" For Input As #ff
                Input #ff, gameTime
                refTime = Now - gameTime
                Input #ff, conflictTime
                Input #ff, flightsDone

                Input #ff, messageQueue
                Input #ff, messageCallsign
                Input #ff, message
                Input #ff, messageTime
                messageTime += Timer

                ReDim tPlane.plane(0)
                p = 0
                Do Until Eof(ff)
                    Input #ff, g
                    If g = "PLANE" Then
                        p += 1
                        tPlane.create(-1)
                        tPlane.plane(p).loadPlane(ff)
                    EndIf
                Loop
                Close ff
                flag.resum = 1
                sessionStartTime = Now
                Exit Do
            ElseIf mouseMenu(" Start new game ",, sc_width / 2 - 55, -40, buttonColor, 2) = 9 Then
                Exit Do
            ElseIf mouseMenu(" Quit ",, sc_width / 2 - 20, -40, buttonColor, 2) = 9 Then
                For x = LBound(planeImg) To UBound(planeImg)
                    ImageDestroy planeImg(x)
                Next
                ImageDestroy bigFontWhite
                ImageDestroy bigFontRed
                ImageDestroy bigFontLtgreyT
                End
            EndIf
            ScreenCopy
            Sleep 1
        Loop
        Width remColumns, remLines 'restore character size
    EndIf

    ''Open "default.lvl" For Output As #1
    ''For x As Integer = 1 To UBound(runway)
    ''  runway(x).saveRunway(1)
    ''Next
    ''Close

    '#########################################################

    If flag.resum = 0 Then 'initialize a new game
        ReDim tPlane.plane(0)

        For x = 1 To UBound(runway)
            Select Case runway(x).runwayType
                Case _unidir, _bidir
                    'For y as Integer = 1 To 3
                        tPlane.create(x)
                    'Next
                Case _slot
                    runway(x).inColor = white
                    runway(x).outColor = white
            End Select
        Next

        ''======== for testing bad exit ====================
        'With tPlane.plane(1)
        '   .destination = "HAM"
        '   .position.x = grid * 9
        '   .position.y = grid * 0 + 25
        '   .xdisp = .position.x
        '   .ydisp = .position.y
        '   .target = fix2grid(.position + pol2cart(Type<tPolar>(grid, headingAngle(_N))))
        '   .speed = 400
        '   .targetspeed = 400
        '   .targetaltitude = 5000
        '   .altitude = 5000
        '   .flightstatus = FS_FLYING
        '   .tagDispx = .tagDispBasex + .xdisp
        '   .tagDispy = .tagDispBasey + .ydisp
        'End With
        ''===================================================

        'runway(1).lockIn = 1

        For x = 1 To UBound(runway)
            tPlane.create(x)
        Next

        refTime = Now
        gameTime = 0
        sessionStartTime = Now
    EndIf

    timenew = Timer + lvl.newPlaneGap

    scalePos = fix2grid(Type<tPosition>(grid, radar_sc))
    scalePos = Type<tPosition>(scalePos.x - 10, scalePos.y)


    Do '##### MAIN LOOP #####
        key = InKey
        Line (0, 0) - (sc_width - 1, sc_height - 1), black, bf 'clear screen

        If flag.pause Then
            timenew = Timer + timepause
            Draw String (radar_sc / 2 - 100, radar_sc / 2), "GAME PAUSED",, bigFontWhite
        EndIf

        If Timer > timenew Then 'new plane
            If planes < lvl.maxPlanes Then
                If tPlane.create() Then 'plane creation successful
                    timenew = Timer + lvl.newPlaneGap 'set time gap for next plane
                EndIf
            EndIf
        EndIf
        planes = 0

        'draw grid
        For x = 0 To radar_sc - 1 Step grid
            For y = 0 To radar_sc - 1 Step grid
                PSet (x, y), white
            Next
        Next

        'draw scale
        Line (scalePos.x - 1, scalePos.y - grid) - (scalePos.x + 1, scalePos.y - 2*grid), ltgrey, bf
        Line (scalePos.x - 4, scalePos.y - grid) - (scalePos.x + 4, scalePos.y - grid - 1), ltgrey, bf
        Line (scalePos.x - 4, scalePos.y - 2*grid) - (scalePos.x + 4, scalePos.y - 2*grid + 1), ltgrey, bf
        Draw String (scalePos.x + 5, scalePos.y - 1.5 * grid - 4), Str(NMperGrid) + " NM", ltgrey

        'draw runway(s) and slot(s)
        For x = 1 To UBound(runway)
            If runway(x).runwayType = _slot Then 'set colors for slot direction marks
                runway(x).outColor = white
                runway(x).inColor = white
                For p = 1 To UBound(tPlane.plane)
                    With tPlane.plane(p)
                        If outScreen(.position) AndAlso runway(x).sign = .origin Then 'incoming plane
                            runway(x).inColor = green
                        EndIf
                    End With
                Next
            EndIf
            runway(x).drawRunway
        Next

        If Timer > timeupd Then
            update = 1
            timeupd = Timer + 2.0
        Else
            update = 0
        EndIf

        '----------------------
        totalDelay = 0
        For p = 1 To UBound(tPlane.plane) 'all planes
            With tPlane.plane(p)
                .operate(update)
            End With
        Next
        '----------------------

        '----------------------
        Locate 2,1
        'Color ltgrey
        'If (message.mlock - Timer) > 0 Then
        '   Color red
        'EndIf
        '? "message.mlock ";message.mlock - Timer

        Color ltgrey
        If (messageTime - Timer) > 0 Then
            Color red
        EndIf
        ? "          messageTime";messageTime - Timer
        Color ltgrey
        ? "        messageQueue ";messageQueue
        ? "     messageCallsign ";messageCallsign
        '? "message.message ";message.message
        '----------------------

        Line (radar_sc, 0) - (sc_width - 1, sc_height - 1), black, bf 'clear legend area

        'draw schedule / list
        mouseMenu("CALL    DST",,radar_sc + 25, 226, neutralColor)
        mouseMenu("",,0, -10, neutralColor)

        'list of scheduled planes
        For p = 1 To UBound(tPlane.plane)
            With tPlane.plane(p)
                If (.flightstatus = FS_SCHEDULED) And (.planeflag.takeoff = 0) Then
                    Select Case mouseMenu(.callsign + "   " + .destination,, 0, -10, scheduleColor)
                        Case 8 'show position of scheduled plane
                            Circle (.position.x, .position.y), 5, ltgreen,,,,f
                        Case 9 'left button --> launch plane
                            .planeflag.takeoff = 1
                    End Select
                EndIf
            End With
        Next

        mouseMenu("-----------",,0, -10, neutralColor) 'line between scheduled and airborne



        'list of airborne planes
        For p = 1 To UBound(tPlane.plane)
            With tPlane.plane(p)
                If .flightstatus <> FS_SCHEDULED Then
                    planes += 1
                    mouseMenu(.callsign + "   " + IIf(outScreen(.position), .origin, .destination),, 0, -10, .listColor)
                EndIf
            End With
        Next

        'legend
        If (mouseMenu("  LOAD  ",,radar_sc + 40, radar_sc - 100, buttonColor, 2) = 9) Or (key = "l") Then
            ff = FreeFile
            Open "planes.pln" For Input As #ff
            Input #ff, gameTime
            refTime = Now - gameTime
            sessionStartTime = Now
            Input #ff, conflictTime
            Input #ff, flightsDone
            ReDim tPlane.plane(0)
            p = 0
            Do Until Eof(ff)
                Input #ff, g
                If g = "PLANE" Then
                    p += 1
                    tPlane.create(-1)
                    tPlane.plane(p).loadPlane(ff)
                EndIf
            Loop
            Close ff
            flag.resum = 1 'restart
        EndIf

        If (mouseMenu("  SAVE  ",,0, -25, buttonColor, 2) = 9) Or (key = "s") Then
            ff = FreeFile
            Open "planes.pln" For Output As #ff
            Print #ff, gameTime
            Print #ff, conflictTime
            Print #ff, flightsDone
            For p = 1 To UBound(tPlane.plane)
                tPlane.plane(p).savePlane(ff)
            Next
            Close ff
        EndIf

        If (mouseMenu(" SETUP  ",,0, -25, buttonColor, 2 + 4) = 9) Or (key = "S") Then
            setup(lvl)
            If flag.restart Then
                flag.restart = 0
                Continue Do, Do
            EndIf
        EndIf

        If (mouseMenu(" PAUSE  ",,0, -25, buttonColor, 2 + 4) = 9) Or (key = "p") Then
            timepause = timenew - Timer
            If flag.pause Then
                flag.pause = 0
                refTime += (Now - timeremPause)
                sessionStartTime += (Now - timeremPause)
            Else
                flag.pause = 1
                timeremPause = Now
            EndIf
        EndIf

        Line (radar_sc - 1, 0) - (radar_sc + 4, radar_sc - 1), midgrey, bf 'right radar screen border
        Line (0, radar_sc + 1) - (sc_width - 1, radar_sc + 2), midgrey, bf 'radar screen bottom border

        'print delay
        If (60 * Hour(totalDelay) + Minute(totalDelay)) >= 100 Then
            Draw String (300, 230), Str(60 * Hour(totalDelay) + Minute(totalDelay)) + " MINUTES DELAY",, bigfontRed
            firedReason = "Delay"
            flag.fired = 1 'game over
        EndIf

        'print conflict time
        For p = 1 To UBound(tPlane.plane)
            With tPlane.plane(p)
                If .planeflag.conflict Then
                    conflictTime += (Timer - timerem)
                    If conflictTime > 60 Then
                        Draw String (300, 230), Str(Int(conflictTime)) + " SECONDS OF CONFLICT", red, bigFontRed
                        firedReason = "Conflict"
                        flag.fired = 1 'game over
                    EndIf
                    Exit For
                EndIf
            End With
        Next
        timerem = Timer

        'delete exited/landed planes
        x = UBound(tPlane.plane)
        For p = 1 To x
            With tPlane.plane(p)
                If .planeflag.crash Then 'plane crashed
                    Circle (.position.x, .position.y), 25, red
                    Draw String (300, 250), "YOU CAUSED A CRASH",, bigFontRed
                    firedReason = "Crash"
                    flag.fired = 1 'game over
                EndIf

                If (.flightstatus = FS_EXIT) Then 'correct exit
                    .flightstatus = FS_REMOVE
                ElseIf (.flightstatus = FS_BADEXIT) Then 'bad exit
                    Draw String (200, 270), .callsign + " BAD EXIT: " + .comment,, bigFontRed
                    For x As Integer = 40 To 53 Step 4
                        Circle (.position.x, .position.y), x, red
                    Next

                    'Locate 2,1
                    'Print "destination ";.destination
                    'Print " position x ";.position.x
                    'Print " position y ";.position.y
                    'Print "   target x ";.target.x
                    'Print "   target y ";.target.y
                    'Print "   altitude ";.altitude
                    'Print "  direction ";.direction
                    'Print "    heading ";.mark.heading;" (";cardinalPoint(.mark.heading);")"
                    'Print "       turn ";.turn
                    'Print "      speed ";.speed

                    firedReason = "Bad exit " + .comment
                    flag.fired = 1
                EndIf

                If (.flightstatus = FS_REMOVE) Then 'remove plane from array
                    If InStr(messageQueue, .callsign) Then 'remove callsign from messegeQueue
                        Dim As Integer cs = InStr(messageQueue, .callsign)
                        messageQueue = Left(messageQueue, cs - 1) + Mid(messageQueue, cs + Len(.callsign))
                    EndIf
                    If .callsign = messageCallsign Then
                        message = ""
                        messageCallsign = ""
                    EndIf
                    For y = p To x - 1
                        Swap tPlane.plane(y), tPlane.plane(y + 1)
                    Next
                    ReDim Preserve tPlane.plane(x - 1)
                    flightsDone += 1
                    Exit For
                ElseIf (.flightstatus = FS_RESCHEDULE) Then '--> replace to schedule
                    .flightstatus = FS_SCHEDULED
                EndIf
            End With
        Next

        gameTime = Now - refTime - IIf(flag.pause, Now - timeremPause, 0)
        sessionTime = Now - sessionStartTime - IIf(flag.pause, Now - timeremPause, 0)

        x = radar_sc + 10
        y = 5
        Draw String (x, y), "TOTAL TIME",white
        Draw String (x, y + 12), Format(gameTime, "hh:mm:ss"),, bigFontLtgreyT
        Line (x - 5, Y + 29) - (sc_width, y + 32), midgrey, bf

        y += 36
        Draw String (x, y), "SESSION TIME",white
        Draw String (x, y + 12), Format(sessionTime, "hh:mm:ss"),, bigFontLtgreyT
        Line (x - 5, Y + 29) - (sc_width, y + 32), midgrey, bf

        y += 36
        Draw String (x, y), "AIRBORNE",white
        Draw String (x + 40, y + 12), Str(planes),, bigFontLtgreyT
        Line (x - 5, y + 29) - (sc_width, y + 32), midgrey, bf

        y += 36
        Draw String (x, y), "DONE",white
        Draw String (x + 40, y + 12), Str(flightsDone),, bigFontLtgreyT
        Line (x - 5, y + 29) - (sc_width, y + 32), midgrey, bf

        y += 36
        Select Case conflictTime
            Case Is >= 60
                fontColor = bigfontRed
            Case Is > 50
                fontColor = bigFontYellow
            Case Else
                fontColor = bigFontLtgreyT
        End Select
        Draw String (x, y), "CONFLICT",white
        Draw String (x + 40, y + 12), Str(Int(conflictTime)),, fontColor
        Line (x - 5, y + 29) - (sc_width, y + 32), midgrey, bf

        y += 36
        Select Case 60 * Hour(totalDelay) + Minute(totalDelay)
            Case Is >= 100
                fontColor = bigfontRed
            Case Is > 80
                fontColor = bigFontYellow
            Case Else
                fontColor = bigFontLtgreyT
        End Select
        Draw String (x, y), "DELAY",white
        Draw String (x + 20, y + 12), Str(60 * Hour(totalDelay) + Minute(totalDelay)) + ":" + Format(totalDelay, "ss"),, fontColor
        Line (x - 5, y + 29) - (sc_width, y + 32), midgrey, bf

        Line (0, radar_sc + 3) - (sc_width - 1, sc_height), black, bf 'clear message area
        Draw String (100, radar_sc + 10), message,, midFontWhite 'print message

        ScreenCopy
        Sleep 1
    Loop Until (key = " " And flag.pause = 0) Or (flag.fired = 1)
    Exit Do 'game over
Loop 'level setup loop --> to restart the game


If flag.fired Then
    ff = FreeFile
    Open ExePath + "/history.ber" For Append As #ff
    Print #ff, "----------"
    'Print #ff, Date;" ";Time
    Print #ff, Format(Now, "dd.mm.yyyy hh:mm:ss")
    Print #ff, firedReason
    Print #ff, "Flights completed: ";flightsDone
    Print #ff, "Total time: ";Format(Now - refTime, "hh:mm:ss")
    Print #ff, "Conflict: ";conflictTime
    Print #ff, "Delay: ";Format(totalDelay, "ss")
    Print #ff, "Level: ";lvl.maxPlanes
    Close ff

    Draw String (350, 300), "YOU ARE FIRED!",, bigFontRed
    Kill (ExePath + "/resume.pln")
Else 'save actual game for resume
    Draw String (300, 300), "YOU COMPLETED " + Str(flightsDone) + " FLIGHTS",, bigFontWhite
    Draw String (300, 330), "IN " + Format(Now - refTime, "hh:mm:ss"),,bigFontWhite
    ff = FreeFile
    Open "resume.pln" For Output As #ff
    Print #ff, gameTime
    Print #ff, conflictTime
    Print #ff, flightsDone

    Print #ff, messageQueue
    Print #ff, messageCallsign
    Print #ff, message
    Print #ff, messageTime - Timer

    For p = 1 To UBound(tPlane.plane)
        tPlane.plane(p).savePlane(ff)
    Next
    Close ff
EndIf

ScreenCopy

Sleep

For x = LBound(planeImg) To UBound(planeImg)
    ImageDestroy planeImg(x)
Next
ImageDestroy bigFontWhite
ImageDestroy bigFontRed
ImageDestroy bigFontLtgreyT

End


outlineStraight:
Data ".........xx........."'1
Data "........x..x........"'2
Data "........x..x........"'3
Data "........x..x........"'4
Data "........x..x........"'5
Data ".......x....x......."'6
Data ".......x....x......."'7
Data ".....xx......xx....."'8
Data "....x..........x...."'9
Data "..xx....x..x....xx.."'10
Data ".x.....x....x.....x."'11
Data "x...x.x.x..x.x.x...x"'12
Data "xx.x....x..x....x.xx"'13
Data "........x..x........"'14
Data "........x..x........"'15
Data "........x..x........"'16
Data ".......x....x......."'17
Data "......x......x......"'18
Data ".....x...xx...x....."'19
Data ".....x.x....x.x....."'20

filledStraight:
Data ".........xx........."'1
Data "........xxxx........"'2
Data "........xxxx........"'3
Data "........xxxx........"'4
Data "........xxxx........"'5
Data ".......xxxxxx......."'6
Data ".......xxxxxx......."'7
Data ".....xxxxxxxxxx....."'8
Data "....xxxxxxxxxxxx...."'9
Data "..xxxxxxxxxxxxxxxx.."'10
Data ".xxxxxxxxxxxxxxxxxx."'11
Data "xxxxxxx.xxxx.xxxxxxx"'12
Data "xxxx....xxxx....xxxx"'13
Data "........xxxx........"'14
Data "........xxxx........"'15
Data "........xxxx........"'16
Data ".......xxxxxx......."'17
Data "......xxxxxxxx......"'18
Data ".....xxxxxxxxxx....."'19
Data ".....x.x....x.x....."'20


outlineDiagonal:
Data ".................../"'1*
Data "................xxx."'2*
Data "...............x./x."'3*
Data "..xxxxxxxxxxxxx./.x."'4*
Data ".x............./.x.."'5*
Data "..xxxx......../.x..."'6
Data "......xxxxx../..x..."'7
Data ".........x../...x..."'8
Data "........x../....x..."'9
Data ".......x../..x..x..."'10
Data "........./..xx..x..."'11
Data "..x...x./..x.x..x..."'12
Data ".x.xxx./..x..x..x..."'13
Data ".x..../.x....x..x..."'14
Data "..xx./.x......x.x..."'15
Data "....x..x......x.x..."'16
Data ".../.x.x......x.x..."'17
Data "../..x..x.....x.x..."'18
Data "./....xx.......x...."'19
Data "/..................."'20

filledDiagonal:
Data ".................../"'1*
Data "................xxx."'2*
Data "...............xxxx."'3*
Data "..xxxxxxxxxxxxxxxxx."'4*
Data ".xxxxxxxxxxxxxxxxx.."'5*
Data "..xxxxxxxxxxxxxxx..."'6
Data "......xxxxxxxxxxx..."'7
Data ".........xxxxxxxx..."'8
Data "........xxxxxxxxx..."'9
Data ".......xxxxxxxxxx..."'10
Data ".......xxxxxxxxxx..."'11
Data "..x...xxxxxx.xxxx..."'12
Data ".xxxxxxxxxx..xxxx..."'13
Data ".xxxxxxxx....xxxx..."'14
Data "..xxxxxx......xxx..."'15
Data "....xxxx......xxx..."'16
Data ".../.xxx......xxx..."'17
Data "../..xxxx.....xxx..."'18
Data "./....xx.......x...."'19
Data "/..................."'20


Function zoomText(text As String, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
    Dim As Any Ptr img, imgz
    Dim As Integer w, h
    Dim As Integer sc_width, sc_height, ch_width, ch_height
    Dim As ULong pnt

    'character size
  ScreenInfo sc_width, sc_height
  ch_width = sc_width / LoWord(Width)
  ch_height = sc_height / HiWord(Width)

    img = ImageCreate(Len(text) * ch_width, ch_height, background, 32)
    ImageInfo img, w, h
    imgz = ImageCreate(w * 2, h * 2, background, 32)
    Draw String img, (0,0), text, foreground
    For x As Integer = 0 To w - 1
        For y As Integer = 0 To h - 1
            pnt = Point(x, y, img)
            PSet imgz, (x * 2, y * 2), pnt
            PSet imgz, (x * 2 + 1, y * 2), pnt
            PSet imgz, (x * 2, y * 2 + 1), pnt
            PSet imgz, (x * 2 + 1, y * 2 + 1), pnt
        Next
    Next
    ImageDestroy img
    Return imgz

End Function

Function turnImg(img As Any Ptr, d As String = "r") As Any Ptr
    Dim As Integer w, h, bpp, x, y
    Dim As Any Ptr ret

    ImageInfo img, w, h, bpp
    ret = ImageCreate(h, w, RGB(0,0,0), bpp/8)

    For x = 0 To w - 1
        For y = 0 To h - 1
            Select Case d
                Case "l"
                    PSet ret, (y, x), Point(w - 1 - x, y, img) 'turn left
                Case "r"
                    PSet ret, (y, x), Point(x, h - 1 - y, img) 'turn right
                Case Else
                    ImageDestroy ret
                    Return 0
            End Select
        Next
    Next

    Return ret

End Function

Function fix2grid(ByRef p As tPosition) As tPosition

    p.x = Int(p.x / grid  + .5) * grid
    p.y = Int(p.y / grid  + .5) * grid

    Return p

End Function

Sub setup(ByRef lvl As tSetup)
    Dim As Integer sc_width, sc_height, remColumns, remLines, px, py, x
    Dim As Integer Zeilen, Spalten
    Dim As Double timerem = Now
    Dim As String text
    Dim As tMMcolors listColor, buttonColorChecked
    Dim As tSetup remSetup = lvl
    ReDim As String level(1)

    '? remSetup.lvlName
    '? remSetup.maxPlanes
    '? remSetup.newPlaneGap
    '?
    '? lvl.lvlName
    '? lvl.maxPlanes
    '? lvl.newPlaneGap
    'ScreenCopy
    'Sleep
    'End

    With buttonColorChecked
        .text = yellow
        .bgnd = black
    End With

    With lvl
        'save current character size
        remLines = HiWord(Width)
        remColumns = LoWord(Width)

        flag.pause = 1
        ScreenInfo sc_width, sc_height
        Width sc_width / 8, sc_height / 16

        level(1) = Dir("*.lvl")
        Do 'get all level files
            ReDim Preserve level(UBound(level) + 1)
            level(UBound(level)) = Dir("")
        Loop While Len(level(UBound(level)))
        ReDim Preserve level(UBound(level) - 1)

        Do
            Cls
            px = sc_width / 2 - 100
            py = 30
            Put (px,py),zoomText("SETUP"), Trans

            'max planes
            px = sc_width / 2 + 40
            py = 150
            Draw String (px - 240,py), "Maximum planes airborne  " + Str(.maxPlanes), white
            If mouseMenu(" + ",,px,py - 15, buttonColor, 2) = 9 Then
                .maxPlanes += 1
            ElseIf mouseMenu(" - ",,px,py + 15, buttonColor, 2) = 9 Then
                If .maxPlanes > 1 Then
                    .maxPlanes -= 1
                EndIf
            ElseIf mouseMenu(" reset ",,px + 35,py, buttonColor, 2) = 9 Then
                .maxPlanes = remSetup.maxPlanes
            EndIf

            'gap
            px = sc_width/2 + 40
            py = 250
            Draw String (px - 288,py), "Gap between new planes  " + Str(.newPlaneGap) + "  seconds", white
            If mouseMenu(" + ",,px,py - 15, buttonColor, 2) = 9 Then
                .newPlaneGap += 1
            ElseIf mouseMenu(" - ",,px,py + 15, buttonColor, 2) = 9 Then
                'If .newPlaneGap > 17 Then
                If .newPlaneGap > 1 Then
                    .newPlaneGap -= 1
                EndIf
            ElseIf mouseMenu(" reset ",,px + 35,py, buttonColor, 2) = 9 Then
                .newPlaneGap = remSetup.newPlaneGap
            EndIf

            'helping features
            'turning indicator
            px = sc_width/2 - 218
            py = 350
            text = "Show turning "
            Draw String (px, py), text, white
            px += Len(text) * 8
            If mouseMenu(" permanent ",,px, py, IIf(.helpturn = 2, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpturn = 2
            ElseIf mouseMenu(" at touch ",,px + 98, py, IIf(.helpturn = 1, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpturn = 1
            ElseIf mouseMenu(" off ",,px + 98 + 90,py, IIf(.helpturn = 0, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpturn = 0
            EndIf

            'destination in tag
            px = sc_width/2 - 282
            py = 380
            text = "Show callsign in tag "
            Draw String (px, py), text, white
            px += Len(text) * 8
            If mouseMenu(" permanent ",,px, py, IIf(.helpdest = 2, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpdest = 2
            ElseIf mouseMenu(" at touch ",,px + 98, py, IIf(.helpdest = 1, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpdest = 1
            ElseIf mouseMenu(" off ",,px + 98 + 90,py, IIf(.helpdest = 0, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpdest = 0
            EndIf

            'cange tag color if message
            px = sc_width/2 - 338
            py = 410
            text = "Change tag color if message "
            Draw String (px, py), text, white
            px += Len(text) * 8
            If mouseMenu(" permanent ",,px, py, IIf(.helpmessage = 2, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpmessage = 2
            ElseIf mouseMenu(" at touch ",,px + 98, py, IIf(.helpmessage = 1, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpmessage = 1
            ElseIf mouseMenu(" off ",,px + 98 + 90,py, IIf(.helpmessage = 0, buttonColorChecked, buttonColor), 2) = 9 Then
                .helpmessage = 0
            EndIf

            'levels
            px = sc_height/2 - 50
            py = 480
            For x = 1 To UBound(level)
                listColor = buttonColor
                If .lvlName = level(x) Then
                    listColor.text = yellow
                EndIf
                If mouseMenu(level(x),, px, py + 15 * x, listColor) = 9 Then
                    .lvlName = level(x)
                EndIf
            Next

            'back to game
            px = sc_height/2 - 50
            py = sc_height - 50
            If mouseMenu(" Return to game ",,px, py, buttonColor, 2) = 9 Then
                Exit Do
            EndIf

            ScreenCopy
            Sleep 1
        Loop
    End With

    saveini(lvl)

    If lvl.lvlName <> remSetup.lvlName Then
        flag.restart = 1
    EndIf

    'update plane times
    For p As Integer = 1 To UBound(tPlane.plane)
        tPlane.plane(p).operate(0)
    Next

    Width remColumns, remLines 'restore character size

    flag.pause = 0
    refTime += (Now - timerem)
    sessionStartTime += (Now - timerem)


End Sub

Sub saveini(lvl As tSetup)
    Dim As Integer ff

    ff = FreeFile
    Open "ber.ini" For Output As #ff
    Print #ff, "maxPlanes=";lvl.maxPlanes
    Print #ff, "newPlaneGap=";lvl.newPlaneGap
    Print #ff, "actLevel=";lvl.lvlName
    Print #ff, "helpturn=";lvl.helpturn
    Print #ff, "helpdest=";lvl.helpdest
    Print #ff, "helpmessage=";lvl.helpmessage
    Close ff

End Sub

Function getini(varName As String) As String
    Dim As Integer ff, eq
    Dim As String value, g
    Dim As tSetup lvlDefault

    ff = FreeFile
    If Open ("ber.ini" For Input As #ff) Then 'open or create ini - file
        'create ini - file with default values
        With lvlDefault
            .lvlName = "BER_TXL.lvl"
            .maxPlanes = 8
            .newPlaneGap = 30
        End With
        saveini(lvlDefault)
        ff = FreeFile
        Open "ber.ini" For Input As #ff
    EndIf

    Do 'get <varName> value
        Line Input #ff, g
        eq = InStr(g, "=")
        value = Mid(g, eq + 1)
        If LCase(Left(g, eq - 1)) = LCase(varName) Then 'varName found
            Close ff
            Return value
        EndIf
    Loop Until Eof(ff)

    Close ff

    Return "" 'varName not found

End Function

Function getVar (file As String, varName As String) As String
    Dim As Integer ff, eq
    Dim As String g

    ff = FreeFile
    Open file For Input As #ff

    Do
        Line Input #ff, g
        eq = InStr(g, "=")
        If LCase(Left(g, eq - 1)) = LCase(varName) Then
            Close ff
            Return Mid(g, eq + 1)
        EndIf
    Loop Until Eof(ff)

    Close ff

    Return ""

End Function

Function putVar(file As String, varName As String, value As Integer) As Integer
    Return putVar(file, varName, Str(value))
End Function

Function putVar(file As String, varName As String, value As Double) As Integer
    Return putVar(file, varName, Str(value))
End Function

Function putVar(file As String, varName As String, value As String) As Integer
    Dim As Integer ff, ff2, eq
    Dim As String g, temp
    Dim As Integer flag = TRUE

    ff = FreeFile
    Open file For Input As #ff
    ff2 = FreeFile
    Open "temp.tmp" For Output As #ff2

    Do
        Line Input #ff, g
        eq = InStr(g, "=")
        If LCase(Left(g, eq - 1)) = LCase(varName) Then
            g = varName + "=" + value
            flag = FALSE
        EndIf
        Print #ff2, g
    Loop Until Eof(ff)

    If flag Then
        Print #ff2, varName + "=" + value
    EndIf

    Close ff
    Close ff2
    Kill(file)
    Name("temp.tmp", file)

    Return TRUE

End Function


Function pol2cart(pk As tPolar) As tPosition

  Return Type<tPosition>(pk.r * Cos(pk.phi), pk.r * Sin(pk.phi))

End Function

Function cart2pol(pof As tPosition = Type(0,0), pto As tPosition = Type(0,0)) As tPolar
    Dim As tPosition p = pto - pof

    Return Type<tPolar>(Sqr(p.x * p.x + p.y * p.y), Atan2(p.y, p.x))

End Function

#Macro PrintMenuItem(fg, bg, fr)

    Line buffer, (xPos,yPos - 1)-(xPos + Len(text) * ch_width, yPos + ch_height), bg, bf
    Draw String buffer, (xPos + IIf(Bit(mode, 2),ch_width / 2, 0), yPos), text, fg

    If Bit(mode, 1) Then 'draw frame around text
        Line buffer, (xPos - 1, yPos - 2)-(xPos + 1 + Len(text) * ch_width, yPos + ch_height + 1), fr, b
    EndIf

#EndMacro

Function mouseMenu(text As String, _
                     separator As String = "", _
                     xPos As Integer = 0, _
                     yPos As Integer = 0, _
                     colors As tMMcolors, _
                     mode As UByte = 0, _
                     buffer As Any Ptr = 0) As Integer
  'mode bit 1 set (2) -> draw a frame around the text
  'mode bit 2 set (4) -> shift the text right half a character

  Dim As Integer mx, my, wheel, buttons, separatorpos, returnValue = 0
  Dim As Integer sc_width, sc_height, ch_width, ch_height
  Static As Integer xrem, yrem

  'get character size
  ScreenInfo sc_width, sc_height
  ch_width = sc_width / LoWord(Width)
  ch_height = sc_height / HiWord(Width)

  If yPos = 0 Then
    yPos = yrem
  ElseIf yPos < 0 Then
    yPos = yrem - yPos
    yPos = IIf(yPos < 0, 0, yPos)
  EndIf

  If xPos = 0 Then
    xPos = xrem
  ElseIf xPos < 0 Then
    xPos = xrem - xPos
    xPos = IIf(xPos < 0, 0, xPos)
  EndIf

  'adjust text position
  If separator = "" Then
    separatorpos = Len(text) * ch_width
  Else
    separatorpos = (InStr(text,separator) - 1) * ch_width
    xPos = xPos - separatorpos + ch_width 'position text at separator
  EndIf

  xrem = xPos
  yrem = yPos

    GetMouse (mx, my, wheel, buttons)

    If (mx >= xpos) AndAlso (mx <= xpos + Len(text) * ch_width) AndAlso _
         (my >= yPos) AndAlso (my <= ypos + ch_height) Then 'mouse cursor touches the text
    returnValue Or= 8
        PrintMenuItem(colors.foregroundhi, colors.backgroundhi, colors.framehi) 'highlight menu item
    If buttons Then 'mouse button pressed
        returnValue Or= buttons
        Do 'wait for release of the mouse button
            GetMouse (mx, my, wheel, buttons)
            Sleep 1
        Loop While buttons
    EndIf
    Return returnValue
    EndIf

  PrintMenuItem(colors.foreground, colors.background, colors.frame)

End Function

Function angle2cardinal(angle As Double) As Integer
    Select Case angle
        Case headingAngle(_N) - pi/8 To headingAngle(_N) + pi/8
            Return _N
        Case headingAngle(_NE) - pi/8 To headingAngle(_NE) + pi/8
            Return _NE
        Case headingAngle(_E) - pi/8 To headingAngle(_E) + pi/8
            Return _E
        Case headingAngle(_SE) - pi/8 To headingAngle(_SE) + pi/8
            Return _SE
        Case headingAngle(_S) - pi/8 To headingAngle(_S) + pi/8
            Return _S
        Case headingAngle(_SW) - pi/8 To headingAngle(_SW) + pi/8
            Return _SW
        Case headingAngle(_W) - pi/8 To headingAngle(_W) + pi/8
            Return _W
        Case headingAngle(_NW) - pi/8 To headingAngle(_NW) + pi/8
            Return _NW
        Case Else
            Return -1
    End Select
End Function

Sub drawZoomText(x As Integer, y As Integer, text As String, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255))
    Dim ztp As Any Ptr

    ztp = zoomText(text, foreground, background)
    Put(x, y), ztp, Trans
    ImageDestroy ztp
    ztp = 0
End Sub

Function createBigFont(firstChr As Integer, lastChr As Integer, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
    Dim As UByte Ptr p
    Dim As Any Ptr charPtr, fontPtr, img
    Dim As Integer sc_width, sc_height, bpp, ch_width, ch_height, numberOfChr, x, y, c
    Dim As ULong pnt

    'character size
  ScreenInfo sc_width, sc_height,,bpp
  ch_width = sc_width / LoWord(Width)
  ch_height = sc_height / HiWord(Width)

  numberOfChr = lastChr - firstChr + 1

    fontPtr = ImageCreate(numberOfChr * ch_width * 2, ch_height * 2 + 1)
    p = fontPtr
    p += IIf(p[0] = 7, 32, 4)
    p[0] = 0
    p[1] = firstChr
    p[2] = lastChr

    charPtr = ImageCreate(ch_width * 2, ch_height * 2, background)
    For c = firstChr To lastChr
      p[3 + c - firstChr] = ch_width * 2
      img = ImageCreate(ch_width, ch_height, background)
      Draw String img, (0,0), Chr(c), foreground
      For x = 0 To ch_width - 1
            For y = 0 To ch_height - 1
                pnt = Point(x, y, img)
                PSet charPtr, (x * 2, y * 2), pnt
                PSet charPtr, (x * 2 + 1, y * 2), pnt
                PSet charPtr, (x * 2, y * 2 + 1), pnt
                PSet charPtr, (x * 2 + 1, y * 2 + 1), pnt
            Next
      Next
      ImageDestroy img
      Put fontPtr, ((c - firstChr) * ch_width * 2, 1), charPtr, Trans
    Next
    ImageDestroy charPtr

    Return fontPtr

End Function

Function createMidFont(firstChr As Integer, lastChr As Integer, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
    Dim As UByte Ptr p
    Dim As Any Ptr charPtr, fontPtr, img
    Dim As Integer sc_width, sc_height, bpp, ch_width, ch_height, numberOfChr, x, y, c, _
                   remLines, remColumns
    Dim As ULong pnt

    'character size

    ScreenInfo sc_width, sc_height,,bpp
    remLines = HiWord(Width)
    remColumns = LoWord(Width)
    Width sc_width / 8, sc_height / 16
    ch_width = sc_width / LoWord(Width)
  ch_height = sc_height / HiWord(Width)
  numberOfChr = lastChr - firstChr + 1

    fontPtr = ImageCreate(numberOfChr * ch_width, ch_height + 1)
    p = fontPtr
    p += IIf(p[0] = 7, 32, 4)
    p[0] = 0
    p[1] = firstChr
    p[2] = lastChr

    charPtr = ImageCreate(ch_width, ch_height, background)
    For c = firstChr To lastChr
       p[3 + c - firstChr] = ch_width
      img = ImageCreate(ch_width, ch_height, background)
      Draw String img, (0,0), Chr(c), foreground
      For x = 0 To ch_width - 1
            For y = 0 To ch_height - 1
                pnt = Point(x, y, img)
                PSet charPtr, (x, y), pnt
            Next
      Next
      ImageDestroy img
      Put fontPtr, ((c - firstChr) * ch_width, 1), charPtr, Trans
    Next
    ImageDestroy charPtr
    Width remColumns, remLines 'restore character size

    Return fontPtr

End Function

Function outScreen(p As tPosition) As boolean
    Dim As Integer sc_width, sc_height

    'ScreenInfo sc_width, sc_height
    If (p.x < 0) OrElse (p.x > radar_sc) OrElse _
         (p.y < 0) OrElse (p.y > radar_sc) Then 'p is outside the screen
        Return TRUE
    EndIf
    Return FALSE

End Function

Sub waitRelease
    Dim As Integer x, y, wheel, buttons
    Do
        GetMouse (x,y,wheel,buttons)
        Sleep 1
    Loop While buttons
End Sub