root/trunk/orca/gl/pong.r

ORCA [
    Title: "Pong"
]


task-list: make list! 32

state-machine: func [spec /local sm] [
    sm: context [
        state: none
    ]
    make sm spec
]

task: func [mach state] [
    mach/state: get in mach state
    task-list: append task-list mach
]

run-tasks: does [
    foreach t task-list [do t/state]
]

;-----------------------------------------------------------------------------

;   1   2
; 8       3
;     0
; 7       4
;   6   5

ball-gl: compile-gl [
    verts [
         0    0    0
        -0.2  0.4  0
         0.2  0.4  0
         0.4  0.2  0
         0.4 -0.2  0
         0.2 -0.4  0
        -0.2 -0.4  0
        -0.4 -0.2  0
        -0.4  0.2  0
    ]
    colors [
        255.255.255
        80.80.80
    ]
    fan cv [
       0 0  1 1  1 2  1 3  1 4  1 5  1 6  1 7  1 8  1 1
    ]
]


paddle-gl: compile-gl [
    verts [
        -0.3  2.0  0
         0.3  2.0  0
         0.3 -2.0  0
        -0.3 -2.0  0
    ]
    quads v [
        0 1 2 3
    ]
]


quad: compile-gl [
    verts [
        0 0 0
        0 1 0
        1 1 0
        1 0 0
    ]
    colors [
        255.0.0
        0.255.0
        0.0.255
        128.128.128
    ]
    ;quads cv [0 0  1 1  2 2  3 3]
    quads v [0  1  2  3]
]


ball: context [
    vel: <0 0 0>
    pos: <0 0 0>
]


player: context [
    pos: <0 0 0>
    hold: false
    im: none
]


;-----------------------------------------------------------------------------


player1: make player
[
    pos: <-10 0 0>
    comment {
    im: activate input-map [
        ppos/y [
            mouse-dy [input * 0.01 + ppos/y]
            up   on  [ppos/y + 0.5]
            down on  [ppos/y - 0.5]
        ]
        hold [
            spc [true]
        ]
    ]
    }
]


player2: make player
[
    pos: <10 0 0>
]


world-rp: render-prog #world-rp compose [
    push
    scale 3

    push
    trans (ball/pos)
    call  (ball-gl)
    pop

    push
    trans (player1/pos)
    155.255.80
    call  (paddle-gl)
    pop

    push
    trans (player2/pos)
    255.80.155
    call  (paddle-gl)
    pop

    pop
]


comment {
ball-rp: render-prog #ball-rp compose [
    push
    scale 3
    trans (ball/pos)
    call  (ball-gl)
    pop
]


paddleA-rp: render-prog #paddleA-rp compose [
    push
    scale 3
    trans (player1/pos)
    155.255.80
    call  (paddle-gl)
    pop
]


paddleB-rp: render-prog #paddleB-rp compose [
    push
    scale 3
    trans (player2/pos)
    255.80.155
    call  (paddle-gl)
    pop
]
}




scoreA: 13
scoreB: 12
;scoreA-pos: 1x1   widget resize computes this

scores-rp: render-prog #score-rp [
    255.255.255
    ;pen :scoreA-pos
    pen -280x-160
    text :scoreA
    pen  280x-160
    text :scoreB
]


pong-sm: state-machine [
    init: [
        print "INIT"
        display/window 640x480
        clear-color 20.30.200
        ;tfont: make-texfont #tfont %data/arial.ttf 32
        sfont: make-texfont/glyphs #sfont %data/arial.ttf 40 "0123456789"
        state: title
    ]

    title: [
        print "TITLE"
    ]

    menu: [
    ]

    play: [
    ]

    exit-query: [
    ]
]


task pong-sm 'init

;probe task-list
run-tasks

exec make widget [
    key-down: key-handler [
        esc [quit]
    ]

    mouse-move: mouse-handler [
        print dy
    ]

    ;resize: [
    ;    scoreA-pos/x: width * 0.25 + left
    ;    scoreA-pos/y: bottom + 12
    ;    scoreB-pos/x: width * 0.75 + left
    ;    scoreB-pos/y: bottom + 12
    ;]

    render: [
        ;run-tasks

        ortho-view self 100x100 none
        render-state 'solid
        call world-rp
        ;call ball-rp
        ;call paddleA-rp
        ;call paddleB-rp

        ortho-view self none none
        render-state sfont
        call scores-rp
    ]
]

;eof