#!/usr/bin/env pf # opengl routines for packet forth provide m-push # load system specific opengl bindings load-opengl-sys # FIXME: sync # best is to use display sync, though this is not really supported well: # for NV drivers it works, but in that case need a timekeeper too. # surface-display # should this be default? NO! pd window created upon request # load the portable opengl binary module "opengl.pfo" pfo : points GL_POINTS vertexarray ;; : lines GL_LINES vertexarray ;; : linestrip GL_LINE_STRIP vertexarray ;; : lineloop GL_LINE_LOOP vertexarray ;; : polygon GL_POLYGON vertexarray ;; : quads GL_QUADS vertexarray ;; : quadstrip GL_QUAD_STRIP vertexarray ;; : trianglestrip GL_TRIANGLE_STRIP vertexarray ;; : trianglefan GL_TRIANGLE_FAN vertexarray ;; : curvearray >r >r eval-map-1 r> r> eval-coord-1 ;; : curve-points GL_POINTS curvearray ;; : curve-lines GL_LINES curvearray ;; : curve-linestrip GL_LINE_STRIP curvearray ;; : curve-lineloop GL_LINE_LOOP curvearray ;; : curve-polygon GL_POLYGON curvearray ;; ## these don't really make sense # : curve-quads GL_QUADS curvearray ;; # : curve-quadstrip GL_QUAD_STRIP curvearray ;; # : curve-trianglestrip GL_TRIANGLE_STRIP curvearray ;; # : curve-trianglefan GL_TRIANGLE_FAN curvearray ;; # gsl is needed for native matrix manipulation load-matrix load-image # TODO: unify event handling # library functions # capture a drawing word in a display list # ( xt.drawer -- xt.dl.drawer ) : displaylist dlist-begin constant execute dlist-end # ( -- ) does> dlist-draw ; "( xt.draw -- xt.displaylist )\tCapture a drawing word in a display list. Can't be nested." doc : make-dlist dlist-begin >r execute dlist-end r> ; "( xt.draw -- displaylist )\tCreate a display list as object: pass to 'dlist-draw' to draw." doc : aspect screendims 2 pack ['] >float map unpack / ; # global state variables ip variable! curtex # current texture : image>texture ` gl-bitmap bitmap-from-image # gl-bitmap type preserves channels.. bitmap>texture ; # default texture convert (rgb) # polywords ' bitmap>texture polyword >texture ' image>texture polyword >texture : cleartexture 0 texture ; "( - )\tClear current texture." doc : trans 0 swap @trans ; "( vector - )\tSet translation from vector." doc : color 0 swap @color ; "( vector - )\tSet color from vector." doc # utility "texture.pf" load # below this line are experimental convenience library functions # i want to keep the count low and the functionality high.. defer drawer "( -- )\tInner drawing deferred word." , defer responder "( event -- )\tEvent handler deferred word." , :noname ; is drawer :noname drop ; is responder 33.0 renderperiod ! # coordinate systems. note 'dims>3d' sets eye at 0,0,4 # the 2d system takes the hight of the screen to be 1, and the with # equal to 'aspect', with (0,0) in the middle of the screen, and # (1/2, aspect/2) the top right. # window coordinates are set as (0,0) = top left and (1,1) = bottom # right (y-axis pointing downwards) : 2d-clearscreen screendims dims>2d wipe 0 depth ; defer clearscreen # this is a really bad name : 3d { screendims dims>3d wipe } is clearscreen ; : 2d { 2d-clearscreen } is clearscreen ; : 2d-m-window-relative m-identity 1. transy -1. scaley ; "( -- )\tUse window-relative coordinates: (0,0) = topleft, (1,1) = bottomright." doc : 2d-m-window-pixel 2d-m-window-relative screendims inverse scaley inverse scalex ; "( -- )\tUse window pixel coordinates: (0,0) = topleft, (w-1,h-1) = bottomright." doc : 2d-window-relative { 2d-clearscreen 2d-m-window-relative } is clearscreen ; : 2d-window-pixel { 2d-clearscreen 2d-m-window-pixel } is clearscreen ; 3d : poll-events events ['] responder for-each ; # user event handler : animate-update makecurrent clearscreen # init display poll-events # poll window system events drawer # call user drawing routine swapbuffers ; # swap back/front buffers : animation { animate-update } is tick ; "( -- )\tPrepare surface to start drawing 3d frame. (usually just swapbuffers)." , # the default run is the animation loop : run animation ; # drawing mode is related to a console: before and after a command is # interpreted, the buffers need to be swapped. there is a possibility # for a race condition when more than one console is active, since the # interpretation step could block. i'm not going to bother with # locking though.. drawing mode is just a hacked up debug feature. : drawing clearscreen swapbuffers { swapbuffers interpret-string swapbuffers } is console-interpret-string { poll-events } is tick ; # convenience stuff : rgba 4 vector color ;; "( r g b a -- )\tSet color from 4 numbers." doc : rgb 1 rgba ;; "( r g b -- )\tSet color from 3 numbers." doc # 2D window events : event-tx-matrix m-push -1. scaley # let opengl do the coord tx modelview@ # get current modelview matrix inverse # compute the inverse, converting screen->modelview coords m-pop ; "( -- matrix )\tGet the matrix to transform display coordinates (from mouse events) into offsets from current point." doc : eventco>vector (0 1) concat 1Dlist>vector ; "( list -- vector )\tTransform a display event coordinate list into a vector that can be used as a left multiple of a transform matrix generated by 'event-tx-matrix'." doc # screenshot: this uses late binding so we don't necessarily have to # load png support : screenshot-png ( load-png # load png support screendims screen>bitmap # capture screen >image >rgb # de-openglize bitmap swap export-png ) # export as png interpret-list ; ; "( filename -- )\tTake a png screenshot. This automagically loads png support if not loaded." doc : screenshot screenshot-png ;; # default is png screenshot "( filename -- )\tSame as screenshot-png." doc : display>rgb screendims screen>bitmap ` rgb bitmap-from-bitmap ; "( -- bitmap )\tConvert screen to bitmap." doc # texture parameters. call this after 'texture' : linear 1 texture-param ; : nearest 0 texture-param ; # alternative blitter: will convert from YCrCb -> rgb, and use texture ( load-opengl 320 240 display 2d : blit YCbCr>rgb clearscreen >texture texture aspect scalex 1. square swapbuffers ; ) drop