root/trunk/thune/gl/test.t

; Thune GL Test


"local_data" change-dir

;1024,768 'fullscreen display
640,480 display

10.0 :zoom
0.0,0.0,0.0 :center

[
    buffer [color vertex] #[
        1.0  1.0  1.0   -1.0  -1.0   0
        1.0  1.0  1.0    1.0  -1.0   0
        1.0  1.0  1.0   -1.0   1.0   0
        1.0  1.0  1.0    1.0   1.0   0
        1.0  0.0  0.0   -0.85 -0.85  0
        0.0  1.0  0.0    0.85 -0.85  0
        0.0  0.0  1.0   -0.85  0.85  0
        1.0  1.0  1.0    0.85  0.85  0
    ]
    depth-test/off blend/off cull/off
    tris #[0 1 2  4 5 6]
    cull
]
draw-list :tri-gp


"shader/matte.gx"
    load.shader :tri-sh

"model/cube.gp"
    load draw-list :model-gp

"shader/colormap.gp"
    load.shader :model-sh

texture!
"image/primal64.png"
;"image/kr_wood01.png"
    load.png make :model-sh/cmap
;model-sh .

font! ["font/20thfont.ttf" 22] make :fontA
font! ["font/FederationBold-KR.ttf" 12 256,128] make :fontF
"shader/rfont.gx" load.shader :fontA-sh
fontA/texture :fontA-sh/cmap
fontA-sh copy :fontF-sh
fontF/texture :fontF-sh/cmap

;0,0,0 :strobe

/*
[
    [
          0,  0,  0
         64, 64, 64
        128,128,128
        192,192,192
        255,255,255
        192,192,192
        128,128,128
         64, 64, 64
    ] :colors
][
    colors next dup tail? ift head
        dup :colors
        first display.swap
]
proc.env :cycle-colors
*/


camera [
    'ortho :fov
    -100.0 :near
     100.0 :far
] make :ortho-cam


camera [
    60.0  :fov
     1.0  :near
   9000.0 :far
   20,20,200,200 :viewport
   #[1.0  0    0    0
     0    1.0  0    0
     0    0    1.0  0
     0    0   15.0  1.0] :orient

    0.0  :azimuth
    0.0  :elev
    15.0 :dist
    0.0,0.0,0.0 :focal-pnt

    [dx dy /*| ced*/]
    [
        dx  0.5 mul to-rad azimuth add :azimuth
        dy -0.5 mul to-rad elev add  -1.53938 1.53938 limit :elev

        ;["az-el" azimuth to-deg elev to-deg] print 

        elev cos dist mul dup /*:ced*/
        azimuth cos /*ced*/  mul focal-pnt/1 add :orient/13
        elev    sin  dist    mul focal-pnt/2 add :orient/14
        azimuth sin /*ced*/  mul focal-pnt/3 add :orient/15

        orient focal-pnt look-at
    ]
    func :turntable

    0 0 turntable
] make :view-cam


-1,-1 :mouse-pos
-1,-1 :click-pos


[
    key-down [
        esc [quit] 
        a   [["area: " area] print]
        p   [/*[100 usleep] proc :sim-update pause-win show*/] 
        f10 [display.snapshot "snapshot.png" save.png]
        f12 ["--- stack ---" print .s]
        ;spc cycle-colors
    ]

    close [quit]

    resize [
        dup :area
        dup :ortho-cam/viewport

        dup :tmp
        tmp/3 2 div  dup :center/x  :tmp/3
        tmp/4 2 div  dup :center/y  :tmp/4
        tmp :view-cam/viewport
    ]

    mouse-move  [
        dup :mouse-pos
        ;"move: "   prin dup .

        mouse-pos/5 zero? iff (
            mouse-pos/3 mouse-pos/4 view-cam/turntable
        )
    ]
    mouse-down  [
        "button: " prin dup .
        ;dup 1 eq? ift (mouse-pos :click-pos)
    ]
    mouse-wheel [
        ;"wheel: "  prin dup .
        ;dup 40.0 div zoom add :zoom
        dup 0 gt? 1.1 0.90909 either zoom mul :zoom
    ]

    joystick [
        axis0  []
    ]

    draw [
        camera view-cam

        blend/off cull depth-test depth-mask
        shader model-sh
        call   model-gp

        camera ortho-cam
        push
            translate center
            scale  zoom
            shader tri-sh
            call   tri-gp
        pop

        ;blend-func 0,0
        blend/trans cull/off depth-test/off depth-mask/off
        shader fontA-sh
        font fontA
        color $ffffff
        text 0,400 "Line 1 abcdefghijklmnopqrstuvwxyz^/Line 2"
        text "- more on same line."
        text 200,200 "200,200"
       ;text/12 mouse-pos mouse-pos

        font fontF
        shader fontF-sh
        text 0,0 "ZERO"
    ]
]
make-widget :background


0,0,155 display.swap

[
    ;[strobe: ping-pong [64,64,64 255,220,64 1]] 'frame-time animate

    handle-events/wait
    background draw
    none display.swap
] forever


;eof